      ***************************************************************
       IDENTIFICATION DIVISION.
      ***************************************************************
       PROGRAM-ID.    P231F90.
       AUTHOR.        B.W. MCNULTY.
       DATE-WRITTEN.  APRIL 01, 1994.
      ***************************************************************
      *                                                             *
      *   PROGRAM:  P231F90 - LOAD FDAT TABLES                      *
      *                                                             *
      *   SYSTEM:   FDAT - TABLE MAINTENANCE SYSTEM                 *
      *                                                             *
      *   FUNCTION: THIS PROGRAM LOADS THE D231 TABLES.             *
      *                                                             *
      *   LANGUAGE: COBOL II                                        *
      *                                                             *
      *   ENTRY:    BEGINNING OF PROGRAM                            *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   DATABASE TABLES AND FILES:                                *
      *                                                             *
      *       DIST INPUT FILE - 'J231.FINTBL(________)'             *
      *                                                             *
      *       OUTPUT DB2 TABLES                                     *
      *            D231.T231DIST                                    *
      *            D231.T231BOOK                                    *
      *            D231.T231RPT                                     *
      *            D231.T231COL                                     *
      *            D231.T231LINE                                    *
      *            D231.T231ORG                                     *
      *            D231.T231RGN                                     *
      *            D231.T231PRIM                                    *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   CALLED SUBROUTINES:                                       *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   MODIFICATIONS:                                            *
      *                                                             *
      *   DATE      PROGRAMMER     DESCRIPTION                      *
      *   --------  -------------  -------------------------------  *
      *   04/01/94  ABLMSC         ORIGINAL VERSION.                *
      *   --------  -------------  -------------------------------  *
      *                                                             *
      ***************************************************************

       ENVIRONMENT DIVISION.

       CONFIGURATION SECTION.

       INPUT-OUTPUT SECTION.

       FILE-CONTROL.

           SELECT  TABLE-INPUT-FILE  ASSIGN TO UT-S-INPUT.

       DATA DIVISION.

       FILE SECTION.

       FD  TABLE-INPUT-FILE
           LABEL RECORDS ARE STANDARD
           RECORDING MODE IS F
           BLOCK CONTAINS 0 RECORDS
           DATA RECORD IS TABLE-INPUT-FILE-RECORD.

       01  TABLE-INPUT-FILE-RECORD      PIC X(80).

           EJECT
       WORKING-STORAGE SECTION.

       01  FILLER                       PIC X(35) VALUE
           'WORKING STORAGE BEGINS HERE ======>'.

       01  W0001-PROGRAM-INFO.
           05  W0001-PROGRAM-NAME       PIC X(08) VALUE 'P231F90'.
           05  CA-PARAGRAPH-NBR         PIC X(04) VALUE '0000'.

       01  W0000-MISCELLANEOUS-FIELDS.
           05  W0000-INPUT-CTR          PIC S9(09) VALUE ZERO.
           05  W0000-OUTPUT-CTR         PIC S9(09) VALUE ZERO.
           05  W0000-TOTAL-DOLLARS      PIC S9(13)V99 VALUE ZERO.
           05  W0000-OUTPUT-DISPLAY     PIC ZZZ,ZZZ,ZZ9.
           05  W0000-OUTPUT-DOLLARS     PIC ----,---,--9.99.

           05  W0000-SEQ-NBR            PIC S9(09) VALUE ZEROES.
           05  W0000-RPT-NBR            PIC  9(03) VALUE ZEROES.
           05  W0000-PREV-BOOK-ID       PIC  X(04) VALUE SPACES.
           05  W0000-PREV-PRIME         PIC  X(04) VALUE SPACES.
           05  W0000-PREV-COL           PIC  X(03) VALUE SPACES.
           05  W0000-PREV-LINE          PIC  X(03) VALUE SPACES.
           05  W0000-F-COL-NBR          PIC  9(02) VALUE ZEROES.
           05  W0000-F-COL-N            REDEFINES
               W0000-F-COL-NBR          PIC  X(02).

           05  W0000-PREV-RPT-ID        PIC  X(04) VALUE SPACES.
           05  W0000-COMMENT-SWITCH     PIC  X(01) VALUE SPACES.
               88  W0000-COMMENT-FOUND             VALUE 'Y'.
               88  W0000-NO-COMMENT-FOUND          VALUE 'N'.

           05  W0000-END-OF-FILE-SW     PIC  X(01) VALUE 'N'.
               88  W0000-END-OF-FILE               VALUE 'Y'.
               88  W0000-NOT-END-OF-FILE           VALUE 'N'.

           05  W0000-LAST-REC-WAS-SW    PIC  X(01) VALUE 'N'.
               88  W0000-LAST-REC-WAS-NEW-GROUP    VALUE 'Y'.
               88  W0000-LAST-REC-WAS-OLD-GROUP    VALUE 'N'.

           05  W0000-PRIME-SEQ-SW       PIC  X(01) VALUE 'N'.
               88  W0000-PRIME-SEQ                 VALUE 'Y'.
               88  W0000-NOT-PRIME-SEQ             VALUE 'N'.

           05  W0000-IX                 PIC  S9(04) COMP VALUE +1.
           05  W0000-LIMIT              PIC  S9(04) COMP VALUE +50.
           05  W0000-COMMENT-CTR        PIC S9(09) VALUE ZERO.
           05  W0000-COMMENT-TABLE      PIC X(4000)      VALUE SPACES.
           05  W0000-COMMENT-TABLE-RD   REDEFINES
               W0000-COMMENT-TABLE.
               10  W0000-PREV-COMMENT   OCCURS 50 TIMES.
                   15  W0000-PREV-COMMENT-I PIC X(01).
                   15  W0000-PREV-COMMENT-X PIC X(79).

           EJECT
      ***************************************************************
      *    INPUT RECORD LAYOUTS                                     *
      ***************************************************************
       01  W0001-INPUT-RECORD                 PIC X(80).

       01  W0001-T231DIST   REDEFINES  W0001-INPUT-RECORD.

           05  W0001-T231DIST-REC-TYPE-00.
               10  W0001-T231DIST-COMMENT-IND PIC X(01).
                   88  W0001-T231DIST-COMMENT-REC       VALUE '/'.
               10  W0001-T231DIST-COMMENT     PIC X(79).

           05  W0001-T231DIST-REC-TYPE-01     REDEFINES
               W0001-T231DIST-REC-TYPE-00.
               10  W0001-F-DSLN-N             PIC X(03).
               10  W0001-DB-RECTYP-C          PIC X(01).
                   88  W0001-T231DIST-REC-TYPE-1        VALUE '1'.
                   88  W0001-T231DIST-REC-TYPE-2        VALUE '2'.
               10  W0001-F-DSID-X             PIC X(76).

           05  W0001-T231DIST-REC-TYPE-02     REDEFINES
               W0001-T231DIST-REC-TYPE-00.
               10  W0001-F-DSLN-N-RD          PIC X(03).
               10  W0001-DB-RECTYP-C-RD       PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-BKID01-C           PIC X(04).
               10  W0001-A-CPY01-N            PIC X(02).
               10  W0001-F-BRST01-I           PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-BKID02-C           PIC X(04).
               10  W0001-A-CPY02-N            PIC X(02).
               10  W0001-F-BRST02-I           PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-BKID03-C           PIC X(04).
               10  W0001-A-CPY03-N            PIC X(02).
               10  W0001-F-BRST03-I           PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-BKID04-C           PIC X(04).
               10  W0001-A-CPY04-N            PIC X(02).
               10  W0001-F-BRST04-I           PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-BKID05-C           PIC X(04).
               10  W0001-A-CPY05-N            PIC X(02).
               10  W0001-F-BRST05-I           PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-BKID06-C           PIC X(04).
               10  W0001-A-CPY06-N            PIC X(02).
               10  W0001-F-BRST06-I           PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-BKID07-C           PIC X(04).
               10  W0001-A-CPY07-N            PIC X(02).
               10  W0001-F-BRST07-I           PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-BKID08-C           PIC X(04).
               10  W0001-A-CPY08-N            PIC X(02).
               10  W0001-F-BRST08-I           PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-BKID09-C           PIC X(04).
               10  W0001-A-CPY09-N            PIC X(02).
               10  W0001-F-BRST09-I           PIC X(01).
               10  FILLER                     PIC X(04).

       01  W0001-T231BOOK   REDEFINES  W0001-INPUT-RECORD.

           05  W0001-T231BOOK-REC-TYPE-00.
               10  W0001-T231BOOK-COMMENT-IND PIC X(01).
                   88  W0001-T231BOOK-COMMENT-REC       VALUE '/'.
               10  W0001-T231BOOK-COMMENT     PIC X(79).

           05  W0001-T231BOOK-REC-TYPE-01     REDEFINES
               W0001-T231BOOK-REC-TYPE-00.
               10  W0001-F-BKID-C             PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-BK-RECTYP-C          PIC X(01).
                   88  W0001-T231BOOK-REC-TYPE-1        VALUE '1'.
                   88  W0001-T231BOOK-REC-TYPE-2        VALUE '2'.
                   88  W0001-T231BOOK-REC-TYPE-3        VALUE '3'.
                   88  W0001-T231BOOK-REC-TYPE-4        VALUE '4'.
                   88  W0001-T231BOOK-REC-TYPE-5        VALUE '5'.
                   88  W0001-T231BOOK-REC-TYPE-6        VALUE '6'.
               10  FILLER                     PIC X(01).
               10  W0001-F-TBL-C              PIC X(01).
               10  W0001-F-BKID-X01           PIC X(72).

           05  W0001-T231BOOK-REC-TYPE-02     REDEFINES
               W0001-T231BOOK-REC-TYPE-00.
               10  W0001-F-BKID-C-02          PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-DB-RECTYP-C-BK02     PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-A-PGCNT-N            PIC X(02).
               10  W0001-F-BKID-X02           PIC X(71).

           05  W0001-T231BOOK-REC-TYPE-03     REDEFINES
               W0001-T231BOOK-REC-TYPE-00.
               10  W0001-F-BKID-C-03          PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-DB-RECTYP-C-BK03     PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-PRNT-C             PIC X(01).
               10  W0001-F-RPT01-C            PIC X(04).
               10  W0001-F-RPT02-C            PIC X(04).
               10  W0001-F-RPT03-C            PIC X(04).
               10  W0001-F-RPT04-C            PIC X(04).
               10  W0001-F-RPT05-C            PIC X(04).
               10  W0001-F-RPT06-C            PIC X(04).
               10  W0001-F-RPT07-C            PIC X(04).
               10  W0001-F-RPT08-C            PIC X(04).
               10  W0001-F-RPT09-C            PIC X(04).
               10  W0001-F-RPT10-C            PIC X(04).
               10  W0001-F-RPT11-C            PIC X(04).
               10  W0001-F-RPT12-C            PIC X(04).
               10  W0001-F-RPT13-C            PIC X(04).
               10  W0001-F-RPT14-C            PIC X(04).
               10  W0001-F-RPT15-C            PIC X(04).
               10  W0001-F-RPT16-C            PIC X(04).
               10  W0001-F-RPT17-C            PIC X(04).
               10  W0001-F-RPT18-C            PIC X(04).

           05  W0001-T231BOOK-REC-TYPE-04     REDEFINES
               W0001-T231BOOK-REC-TYPE-00.
               10  W0001-F-BKID-C-04          PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-DB-RECTYP-C-BK04     PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-PRT-LVL-DATA.
                   15  W0001-F-PRMACCT-C01    PIC X(04).
                   15  W0001-F-PRMACCT-C02    PIC X(04).
                   15  W0001-F-PRMACCT-C03    PIC X(04).
                   15  W0001-F-PRMACCT-C04    PIC X(04).
                   15  W0001-F-PRMACCT-C05    PIC X(04).
                   15  W0001-F-PRMACCT-C06    PIC X(04).
                   15  W0001-F-PRMACCT-C07    PIC X(04).
                   15  W0001-F-PRMACCT-C08    PIC X(04).
                   15  FILLER                 PIC X(34).
               10  W0001-F-PRTLVLS            REDEFINES
                   W0001-F-PRT-LVL-DATA.
                   15  W0001-F-PRTLVL01-C1    PIC X(03).
                   15  W0001-F-PRTLVL02-C1    PIC X(03).
                   15  W0001-F-PRTLVL03-C1    PIC X(03).
                   15  W0001-F-PRTLVL04-C1    PIC X(03).
                   15  W0001-F-PRTLVL05-C1    PIC X(03).
                   15  W0001-F-PRTLVL06-C1    PIC X(03).
                   15  W0001-F-PRTLVL07-C1    PIC X(03).
                   15  W0001-F-PRTLVL08-C1    PIC X(03).
                   15  W0001-F-PRTLVL09-C1    PIC X(03).
                   15  W0001-F-PRTLVL10-C1    PIC X(03).
                   15  W0001-F-PRTLVL11-C1    PIC X(03).
                   15  W0001-F-PRTLVL01-C2    PIC X(03).
                   15  W0001-F-PRTLVL02-C2    PIC X(03).
                   15  W0001-F-PRTLVL03-C2    PIC X(03).
                   15  W0001-F-PRTLVL04-C2    PIC X(03).
                   15  W0001-F-PRTLVL05-C2    PIC X(03).
                   15  W0001-F-PRTLVL06-C2    PIC X(03).
                   15  W0001-F-PRTLVL07-C2    PIC X(03).
                   15  W0001-F-PRTLVL08-C2    PIC X(03).
                   15  W0001-F-PRTLVL09-C2    PIC X(03).
                   15  W0001-F-PRTLVL10-C2    PIC X(03).
                   15  W0001-F-PRTLVL11-C2    PIC X(03).
               10  FILLER                     PIC X(07).

           05  W0001-T231BOOK-REC-TYPE-05     REDEFINES
               W0001-T231BOOK-REC-TYPE-00.
               10  W0001-F-BKID-C-05          PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-DB-RECTYP-C-BK05     PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-PRTSEQ01-C1        PIC X(03).
               10  W0001-F-PRTSEQ02-C1        PIC X(03).
               10  W0001-F-PRTSEQ03-C1        PIC X(03).
               10  W0001-F-PRTSEQ04-C1        PIC X(03).
               10  W0001-F-PRTSEQ05-C1        PIC X(03).
               10  W0001-F-PRTSEQ06-C1        PIC X(03).
               10  W0001-F-PRTSEQ07-C1        PIC X(03).
               10  W0001-F-PRTSEQ08-C1        PIC X(03).
               10  W0001-F-PRTSEQ09-C1        PIC X(03).
               10  W0001-F-PRTSEQ10-C1        PIC X(03).
               10  W0001-F-PRTSEQ11-C1        PIC X(03).
               10  W0001-F-PRTSEQ01-C2        PIC X(03).
               10  W0001-F-PRTSEQ02-C2        PIC X(03).
               10  W0001-F-PRTSEQ03-C2        PIC X(03).
               10  W0001-F-PRTSEQ04-C2        PIC X(03).
               10  W0001-F-PRTSEQ05-C2        PIC X(03).
               10  W0001-F-PRTSEQ06-C2        PIC X(03).
               10  W0001-F-PRTSEQ07-C2        PIC X(03).
               10  W0001-F-PRTSEQ08-C2        PIC X(03).
               10  W0001-F-PRTSEQ09-C2        PIC X(03).
               10  W0001-F-PRTSEQ10-C2        PIC X(03).
               10  W0001-F-PRTSEQ11-C2        PIC X(03).
               10  FILLER                     PIC X(07).

           05  W0001-T231BOOK-REC-TYPE-06     REDEFINES
               W0001-T231BOOK-REC-TYPE-00.
               10  W0001-F-BKID-C-06          PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-DB-RECTYP-C-BK06     PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-ALTSEQ01-C1        PIC X(03).
               10  W0001-F-ALTSEQ02-C1        PIC X(03).
               10  W0001-F-ALTSEQ03-C1        PIC X(03).
               10  W0001-F-ALTSEQ04-C1        PIC X(03).
               10  W0001-F-ALTSEQ05-C1        PIC X(03).
               10  W0001-F-ALTSEQ06-C1        PIC X(03).
               10  W0001-F-ALTSEQ07-C1        PIC X(03).
               10  W0001-F-ALTSEQ08-C1        PIC X(03).
               10  W0001-F-ALTSEQ09-C1        PIC X(03).
               10  W0001-F-ALTSEQ10-C1        PIC X(03).
               10  W0001-F-ALTSEQ11-C1        PIC X(03).
               10  W0001-F-ALTSEQ01-C2        PIC X(03).
               10  W0001-F-ALTSEQ02-C2        PIC X(03).
               10  W0001-F-ALTSEQ03-C2        PIC X(03).
               10  W0001-F-ALTSEQ04-C2        PIC X(03).
               10  W0001-F-ALTSEQ05-C2        PIC X(03).
               10  W0001-F-ALTSEQ06-C2        PIC X(03).
               10  W0001-F-ALTSEQ07-C2        PIC X(03).
               10  W0001-F-ALTSEQ08-C2        PIC X(03).
               10  W0001-F-ALTSEQ09-C2        PIC X(03).
               10  W0001-F-ALTSEQ10-C2        PIC X(03).
               10  W0001-F-ALTSEQ11-C2        PIC X(03).
               10  FILLER                     PIC X(07).

       01  W0001-T231RPT    REDEFINES  W0001-INPUT-RECORD.

           05  W0001-T231RPT-REC-TYPE-00.
               10  W0001-T231RPT-COMMENT-IND  PIC X(01).
                   88  W0001-T231RPT-COMMENT-REC        VALUE '/'.
               10  W0001-T231RPT-COMMENT      PIC X(79).

           05  W0001-T231RPT-REC-TYPE-01      REDEFINES
               W0001-T231RPT-REC-TYPE-00.
               10  W0001-F-RPTID-C            PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-RPT-RECTYP-C         PIC X(01).
                   88  W0001-T231RPT-REC-TYPE-1         VALUE '1'.
                   88  W0001-T231RPT-REC-TYPE-2         VALUE '2'.
                   88  W0001-T231RPT-REC-TYPE-3         VALUE '3'.
                   88  W0001-T231RPT-REC-TYPE-4         VALUE '4'.
                   88  W0001-T231RPT-REC-TYPE-5         VALUE '5'.
                   88  W0001-T231RPT-REC-TYPE-6         VALUE '6'.
                   88  W0001-T231RPT-REC-TYPE-7         VALUE '7'.
                   88  W0001-T231RPT-REC-TYPE-8         VALUE '8'.
               10  FILLER                     PIC X(01).
               10  W0001-F-PGBRK-C            PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-RPTFMT-C           PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-ELIM-C             PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-COLCALC-C          PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-RPT-ORG-C          PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-RPT-RGN-C          PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-RPT-LINE-C         PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-RPT-COL-C          PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-RPTID-X01          PIC X(51).

           05  W0001-T231RPT-REC-TYPE-02      REDEFINES
               W0001-T231RPT-REC-TYPE-00.
               10  W0001-F-RPTID-C-02         PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-DB-RECTYP-C-RPT02    PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-RPT-PRNT-C         PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-RPTLVL01-C         PIC X(04).
               10  W0001-F-RPTLVL02-C         PIC X(04).
               10  W0001-F-RPTLVL03-C         PIC X(04).
               10  W0001-F-RPTLVL04-C         PIC X(04).
               10  W0001-F-RPTLVL05-C         PIC X(04).
               10  W0001-F-RPTLVL06-C         PIC X(04).
               10  W0001-F-RPTLVL07-C         PIC X(04).
               10  W0001-F-RPTLVL08-C         PIC X(04).
               10  W0001-F-RPTLVL09-C         PIC X(04).
               10  W0001-F-RPTLVL10-C         PIC X(04).
               10  W0001-F-RPTLVL11-C         PIC X(04).
               10  FILLER                     PIC X(27).

           05  W0001-T231RPT-REC-TYPE-03      REDEFINES
               W0001-T231RPT-REC-TYPE-00.
               10  W0001-F-RPTID-C-03         PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-DB-RECTYP-C-RPT03    PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-RPT-PRNT-C03       PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-RPTSEQ01-C         PIC X(04).
               10  W0001-F-RPTSEQ02-C         PIC X(04).
               10  W0001-F-RPTSEQ03-C         PIC X(04).
               10  W0001-F-RPTSEQ04-C         PIC X(04).
               10  W0001-F-RPTSEQ05-C         PIC X(04).
               10  W0001-F-RPTSEQ06-C         PIC X(04).
               10  W0001-F-RPTSEQ07-C         PIC X(04).
               10  W0001-F-RPTSEQ08-C         PIC X(04).
               10  W0001-F-RPTSEQ09-C         PIC X(04).
               10  W0001-F-RPTSEQ10-C         PIC X(04).
               10  W0001-F-RPTSEQ11-C         PIC X(04).
               10  FILLER                     PIC X(27).

           05  W0001-T231RPT-REC-TYPE-04      REDEFINES
               W0001-T231RPT-REC-TYPE-00.
               10  W0001-F-RPTID-C-04         PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-DB-RECTYP-C-RPT04    PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-DOLLAR-C           PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD01-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD02-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD03-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD04-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD05-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD06-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD07-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD08-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD09-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD10-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD11-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD12-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD13-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PD14-C             PIC X(03).
               10  FILLER                     PIC X(16).

           05  W0001-T231RPT-REC-TYPE-05      REDEFINES
               W0001-T231RPT-REC-TYPE-00.
               10  W0001-F-RPTID-C-05         PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-DB-RECTYP-C-RPT05    PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-RPTHDG-C           PIC X(73).

       01  W0001-T231LINE   REDEFINES  W0001-INPUT-RECORD.

           05  W0001-T231LINE-REC-TYPE-00.
               10  W0001-T231LINE-COMMENT-IND PIC X(01).
                   88  W0001-T231LINE-COMMENT-REC       VALUE '/'.
               10  W0001-T231LINE-COMMENT     PIC X(79).

           05  W0001-T231LINE-REC-TYPE-01     REDEFINES
               W0001-T231LINE-REC-TYPE-00.
               10  W0001-F-LN-C               PIC X(03).
               10  W0001-LINE-RECTYP-C        PIC X(01).
                   88  W0001-T231LINE-REC-TYPE-1
                                         VALUES ARE 'P', 'R', 'O'.
                   88  W0001-T231LINE-REC-TYPE-2
                                         VALUES ARE '0' THRU '9', ' '.
               10  W0001-F-LINEID-X01         PIC X(76).

           05  W0001-T231LINE-REC-TYPE-02     REDEFINES
               W0001-T231LINE-REC-TYPE-00.
               10  W0001-F-LN-C-02            PIC X(03).
               10  W0001-F-LN-N               PIC X(03).
               10  W0001-F-LN-DESC            PIC X(32).
               10  W0001-F-FMTTYP-C           PIC X(01).
               10  W0001-F-CALC01-CLN         PIC X(04).
               10  W0001-F-CALC01-XLN         PIC X(01).
               10  W0001-F-CALC02-CLN         PIC X(04).
               10  W0001-F-CALC02-XLN         PIC X(01).
               10  W0001-F-CALC03-CLN         PIC X(04).
               10  W0001-F-CALC03-XLN         PIC X(01).
               10  W0001-F-CALC04-CLN         PIC X(04).
               10  W0001-F-CALC04-XLN         PIC X(01).
               10  W0001-F-CALC05-CLN         PIC X(04).
               10  W0001-F-CALC05-XLN         PIC X(01).
               10  W0001-F-CALC06-CLN         PIC X(04).
               10  W0001-F-CALC06-XLN         PIC X(01).
               10  W0001-F-CALC07-CLN         PIC X(04).
               10  W0001-F-CALC07-XLN         PIC X(01).
               10  W0001-F-CALC08-CLN         PIC X(04).
               10  W0001-F-CALC08-XLN         PIC X(01).
               10  FILLER                     PIC X(01).

       01  W0001-T231COL    REDEFINES  W0001-INPUT-RECORD.

           05  W0001-T231COL-REC-TYPE-00.
               10  W0001-T231COL-COMMENT-IND PIC X(01).
                   88  W0001-T231COL-COMMENT-REC        VALUE '/'.
               10  W0001-T231COL-COMMENT      PIC X(79).

           05  W0001-T231COL-REC-TYPE-01      REDEFINES
               W0001-T231COL-REC-TYPE-00.
               10  W0001-F-COL-C              PIC X(03).
               10  W0001-COL-RECTYP-C         PIC X(01).
                   88  W0001-T231COL-REC-TYPE-1
                                         VALUES ARE 'P', 'R', 'O', ' '.
                   88  W0001-T231COL-REC-TYPE-2
                                         VALUES ARE '0' THRU '9'.
               10  W0001-F-COLID-X01          PIC X(76).

           05  W0001-T231COL-REC-TYPE-02      REDEFINES
               W0001-T231COL-REC-TYPE-00.
               10  W0001-F-COL-C-02           PIC X(03).
               10  W0001-F-COL-N              PIC X(02).
               10  W0001-F-COL-HDG1           PIC X(09).
               10  W0001-F-COL-HDG2           PIC X(09).
               10  W0001-F-EDIT-C             PIC X(01).
               10  W0001-F-CALC01-CCOL        PIC X(04).
               10  W0001-F-CALC01-XCOL        PIC X(01).
               10  W0001-F-CALC02-CCOL        PIC X(04).
               10  W0001-F-CALC02-XCOL        PIC X(01).
               10  W0001-F-CALC03-CCOL        PIC X(04).
               10  W0001-F-CALC03-XCOL        PIC X(01).
               10  W0001-F-CALC04-CCOL        PIC X(04).
               10  W0001-F-CALC04-XCOL        PIC X(01).
               10  W0001-F-CALC05-CCOL        PIC X(04).
               10  W0001-F-CALC05-XCOL        PIC X(01).
               10  W0001-F-CALC06-CCOL        PIC X(04).
               10  W0001-F-CALC06-XCOL        PIC X(01).
               10  W0001-F-CALC07-CCOL        PIC X(04).
               10  W0001-F-CALC07-XCOL        PIC X(01).
               10  W0001-F-CALC08-CCOL        PIC X(04).
               10  W0001-F-CALC08-XCOL        PIC X(01).
               10  W0001-F-CALC09-CCOL        PIC X(04).
               10  W0001-F-CALC09-XCOL        PIC X(01).
               10  W0001-F-CALC10-CCOL        PIC X(04).
               10  W0001-F-CALC10-XCOL        PIC X(01).
               10  W0001-F-CALC11-CCOL        PIC X(04).
               10  W0001-F-CALC11-XCOL        PIC X(01).
               10  FILLER                     PIC X(01).

       01  W0001-T231PRIM   REDEFINES  W0001-INPUT-RECORD.

           05  W0001-T231PRIM-REC-TYPE-00.
               10  W0001-T231PRIM-COMMENT-IND PIC X(01).
                   88  W0001-T231PRIM-COMMENT-REC       VALUE '/'.
               10  W0001-T231PRIM-COMMENT     PIC X(79).

           05  W0001-T231PRIM-REC-TYPE-01     REDEFINES
               W0001-T231PRIM-REC-TYPE-00.
               10  W0001-F-PRMACCT-C          PIC X(04).
               10  W0001-F-FCSLN-N            PIC X(02).
               10  W0001-F-BALSHT-C           PIC X(01).
               10  W0001-F-DIVSUM-C           PIC X(01).
               10  W0001-F-PRMACCT-X          PIC X(30).
               10  W0001-CALC-AREA-01.
                   15  W0001-F-CALC01-CPRIM   PIC X(04).
                   15  W0001-F-CALC01-XPRIM   PIC X(01).
                   15  W0001-F-CALC02-CPRIM   PIC X(04).
                   15  W0001-F-CALC02-XPRIM   PIC X(01).
                   15  W0001-F-CALC03-CPRIM   PIC X(04).
                   15  W0001-F-CALC03-XPRIM   PIC X(01).
                   15  W0001-F-CALC04-CPRIM   PIC X(04).
                   15  W0001-F-CALC04-XPRIM   PIC X(01).
                   15  W0001-F-CALC05-CPRIM   PIC X(04).
                   15  W0001-F-CALC05-XPRIM   PIC X(01).
                   15  W0001-F-CALC06-CPRIM   PIC X(04).
                   15  W0001-F-CALC06-XPRIM   PIC X(01).
                   15  W0001-F-CALC07-CPRIM   PIC X(04).
                   15  W0001-F-CALC07-XPRIM   PIC X(01).
                   15  W0001-F-CALC08-CPRIM   PIC X(04).
                   15  W0001-F-CALC08-XPRIM   PIC X(01).
                   15  FILLER                 PIC X(02).
               10  W0001-CALC-AREA-02         REDEFINES
                   W0001-CALC-AREA-01.
                   15  W0001-F-PRMSUBACCT-C.
                       20  W0001-F-SUBACCT-1  PIC X(01).
                       20  W0001-F-SUBACCT-2  PIC X(01).
                       20  W0001-F-SUBACCT-3  PIC X(01).
                       20  W0001-F-SUBACCT-4  PIC X(01).
                       20  W0001-F-SUBACCT-5  PIC X(01).
                       20  W0001-F-SUBACCT-6  PIC X(01).
                       20  W0001-F-SUBACCT-7  PIC X(01).
                       20  W0001-F-SUBACCT-X  PIC X(35).

       01  W0001-T231ORG    REDEFINES  W0001-INPUT-RECORD.

           05  W0001-T231ORG-REC-TYPE-00.
               10  W0001-T231ORG-COMMENT-IND PIC X(01).
                   88  W0001-T231ORG-COMMENT-REC        VALUE '/'.
               10  W0001-T231ORG-COMMENT      PIC X(79).

           05  W0001-T231ORG-REC-TYPE-01      REDEFINES
               W0001-T231ORG-REC-TYPE-00.
               10  W0001-F-ORG-C              PIC X(02).
               10  W0001-F-ORGLVL01-C         PIC X(03).
               10  W0001-F-ORGLVL02-C         PIC X(03).
               10  W0001-F-ORGLVL03-C         PIC X(03).
               10  W0001-F-ORGLVL04-C         PIC X(03).
               10  W0001-F-ORGLVL05-C         PIC X(03).
               10  W0001-F-ORGLVL06-C         PIC X(03).
               10  W0001-F-ORGLVL07-C         PIC X(03).
               10  W0001-F-ORGLVL08-C         PIC X(03).
               10  W0001-F-ORGLVL09-C         PIC X(03).
               10  W0001-F-ORGLVL10-C         PIC X(03).
               10  W0001-F-ORGLVL11-C         PIC X(03).
               10  FILLER                     PIC X(04).
               10  W0001-F-DFLTAFM-C          PIC X(02).
               10  FILLER                     PIC X(08).
               10  W0001-F-ORG-X              PIC X(31).

           05  W0001-T231ORG-REC-TYPE-02      REDEFINES
               W0001-T231ORG-REC-TYPE-00.
               10  W0001-F-ORG-C-02           PIC X(02).
               10  W0001-F-ORGROLLUP01-C      PIC X(02).
               10  W0001-ORG-RECTYP-C         PIC X(01).
                   88  W0001-T231ORG-REC-TYPE-2         VALUE ' '.
               10  W0001-F-ORGROLLUP02-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-ORGROLLUP03-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-ORGROLLUP04-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-ORGROLLUP05-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-ORGROLLUP06-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-ORGROLLUP07-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-ORGROLLUP08-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-ORGROLLUP09-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-ORGROLLUP10-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-ORGROLLUP11-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-ORGID-C            PIC X(04).
               10  W0001-F-ORGPRNT-C          PIC X(01).
               10  W0001-F-DIVAFM01-C         PIC X(04).
               10  W0001-F-DIVAFM02-C         PIC X(04).
               10  W0001-F-DIVAFM03-C         PIC X(04).
               10  W0001-F-ORGLN-X            PIC X(28).

       01  W0001-T231RGN    REDEFINES  W0001-INPUT-RECORD.

           05  W0001-T231RGN-REC-TYPE-00.
               10  W0001-T231RGN-COMMENT-IND  PIC X(01).
                   88  W0001-T231RGN-COMMENT-REC        VALUE '/'.
               10  W0001-T231RGN-COMMENT      PIC X(79).

           05  W0001-T231RGN-REC-TYPE-01      REDEFINES
               W0001-T231RGN-REC-TYPE-00.
               10  W0001-F-RGN-C              PIC X(02).
               10  W0001-F-RGNLVL01-C         PIC X(03).
               10  W0001-F-RGNLVL02-C         PIC X(03).
               10  W0001-F-RGNLVL03-C         PIC X(03).
               10  W0001-F-RGNLVL04-C         PIC X(03).
               10  W0001-F-RGNLVL05-C         PIC X(03).
               10  W0001-F-RGNLVL06-C         PIC X(03).
               10  W0001-F-RGNLVL07-C         PIC X(03).
               10  W0001-F-RGNLVL08-C         PIC X(03).
               10  FILLER                     PIC X(12).
               10  W0001-F-RGN-X              PIC X(42).

           05  W0001-T231RGN-REC-TYPE-02      REDEFINES
               W0001-T231RGN-REC-TYPE-00.
               10  W0001-F-RGN-C-02           PIC X(02).
               10  W0001-F-RGNROLLUP01-C      PIC X(02).
               10  W0001-RGN-RECTYP-C         PIC X(01).
                   88  W0001-T231RGN-REC-TYPE-2         VALUE ' '.
               10  W0001-F-RGNROLLUP02-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-RGNROLLUP03-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-RGNROLLUP04-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-RGNROLLUP05-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-RGNROLLUP06-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-RGNROLLUP07-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-RGNROLLUP08-C      PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-RGNID-C            PIC X(04).
               10  FILLER                     PIC X(01).
               10  W0001-F-RGNLOC-C           PIC X(02).
               10  W0001-F-RGNDIV-C           PIC X(02).
               10  W0001-F-RGNAFM-C           PIC X(02).
               10  FILLER                     PIC X(01).
               10  W0001-F-RGNLN-X            PIC X(42).

       01  W0001-T231MENM   REDEFINES  W0001-INPUT-RECORD.

           05  W0001-T231MNEM-REC-TYPE-01.
               10  FILLER                     PIC X(02).
               10  W0001-MNEM-RECTYP-C        PIC X(01).
                   88  W0001-T231MNEM-REC-TYPE-1   VALUE 'V'.
                   88  W0001-T231MNEM-REC-TYPE-2   VALUE 'F'.
               10  FILLER                     PIC X(01).
               10  W0001-F-MNEM-N             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-MNEM-C             PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PDHDG01-C          PIC X(08).
               10  FILLER                     PIC X(01).
               10  W0001-F-PDHDG02-C          PIC X(08).
               10  FILLER                     PIC X(03).
               10  W0001-F-RLS-C              PIC X(01).
               10  FILLER                     PIC X(05).
               10  W0001-F-AVG-C              PIC X(01).
               10  FILLER                     PIC X(05).
               10  W0001-F-FCSACT-C           PIC X(01).
               10  FILLER                     PIC X(06).
               10  W0001-F-BEGIX-C            PIC X(02).
               10  FILLER                     PIC X(04).
               10  W0001-F-ENDIX-C            PIC X(02).
               10  FILLER                     PIC X(04).
               10  W0001-MNEM-A-CPY-N         PIC X(02).
               10  FILLER                     PIC X(04).
               10  W0001-MNEM-F-DIV-C         PIC X(02).
               10  FILLER                     PIC X(05).
               10  W0001-F-BALIX-C            PIC X(02).
               10  FILLER                     PIC X(02).

           05  W0001-T231MNEM-REC-TYPE-02     REDEFINES
               W0001-T231MNEM-REC-TYPE-01.
               10  FILLER                     PIC X(02).
               10  W0001-MNEM-RECTYP-C2       PIC X(01).
               10  FILLER                     PIC X(01).
               10  W0001-F-MNEM-N2            PIC X(03).
               10  FILLER                     PIC X(02).
               10  W0001-F-MNEMPT-C2          PIC X(03).
               10  FILLER                     PIC X(02).
               10  W0001-F-MNEM-C2            PIC X(03).
               10  FILLER                     PIC X(01).
               10  W0001-F-PDHDG01-C2         PIC X(08).
               10  FILLER                     PIC X(01).
               10  W0001-F-PDHDG02-C2         PIC X(08).
               10  FILLER                     PIC X(45).

           EJECT
      ***************************************************************
      *    DB2 ERROR ROUTINE                                        *
      ***************************************************************
           COPY C108W900.

           EJECT
      ***************************************************************
      *    DB2 INCLUDE MEMBERS                                      *
      ***************************************************************
           EXEC SQL
               INCLUDE SQLCA
           END-EXEC.

           EXEC SQL
               INCLUDE T231DIST
           END-EXEC.

           EXEC SQL
               INCLUDE T231BOOK
           END-EXEC.

           EXEC SQL
               INCLUDE T231RPT
           END-EXEC.

           EXEC SQL
               INCLUDE T231COL
           END-EXEC.

           EXEC SQL
               INCLUDE T231LINE
           END-EXEC.

           EXEC SQL
               INCLUDE T231PRIM
           END-EXEC.

           EXEC SQL
               INCLUDE T231ORG
           END-EXEC.

           EXEC SQL
               INCLUDE T231RGN
           END-EXEC.

           EXEC SQL
               INCLUDE T231MNEM
           END-EXEC.

           EJECT
       LINKAGE SECTION.

       01  PASSED-DATA.
           05  LINK-LENGTH                  PIC  S9(4) COMP.
           05  LINK-TABLE-NAME              PIC  X(08).
           05  LINK-PARM-SEPARATOR          PIC  X(01).
           05  LINK-DIST-ID                 PIC  X(08).

           EJECT
       PROCEDURE DIVISION USING PASSED-DATA.

       A000-MAIN-LOGIC.

           PERFORM A100-INITIALIZATION.

           PERFORM A200-PROCESS-TABLE-INPUT-FILE
             UNTIL W0000-END-OF-FILE.

           PERFORM A300-TERMINATION.

           GOBACK.

           EJECT
       A100-INITIALIZATION.

           MOVE 'A100' TO CA-PARAGRAPH-NBR.

           DISPLAY ' **======================================**'.
           DISPLAY ' **  PROGRAM P231F90 - BEGIN EXECUTION  **'.
           DISPLAY ' **======================================**'.

           DISPLAY ' #############################################'
           DISPLAY ' ## THE PASSED PARM VALUE IS: '
           DISPLAY ' ## '
           DISPLAY ' ##    TABLE NAME: '  LINK-TABLE-NAME
           DISPLAY ' ##    DIST ID   : '  LINK-DIST-ID
           DISPLAY ' ## '
           DISPLAY ' #############################################'

           OPEN INPUT  TABLE-INPUT-FILE.

           EVALUATE LINK-TABLE-NAME
               WHEN 'T231DIST'
                    PERFORM A110-DELETE-T231DIST
               WHEN 'T231BOOK'
                    PERFORM A120-DELETE-T231BOOK
               WHEN 'T231RPT '
                    PERFORM A130-DELETE-T231RPT
               WHEN 'T231LINE'
                    PERFORM A140-DELETE-T231LINE
               WHEN 'T231COL '
                    PERFORM A150-DELETE-T231COL
               WHEN 'T231PRIM'
                    PERFORM A160-DELETE-T231PRIM
               WHEN 'T231ORG '
                    PERFORM A170-DELETE-T231ORG
               WHEN 'T231RGN '
                    PERFORM A180-DELETE-T231RGN
               WHEN 'T231MNEM'
                    PERFORM A190-DELETE-T231MNEM
               WHEN OTHER
                    DISPLAY ' ###################################'
                    DISPLAY ' ##  INVALID PARM VALUE RECEIVED  ##'
                    DISPLAY ' ###################################'
                    MOVE +666 TO RETURN-CODE
           END-EVALUATE.

           EJECT
       A110-DELETE-T231DIST.

           MOVE 'A110' TO CA-PARAGRAPH-NBR.

           MOVE LINK-DIST-ID  TO F-DSID-C  IN DCLT231DIST.

           EXEC SQL
                DELETE FROM D231.T231DIST
                 WHERE F_DSID_C      = :DCLT231DIST.F-DSID-C
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       A120-DELETE-T231BOOK.

           MOVE 'A120' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                DELETE FROM D231.T231BOOK
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       A130-DELETE-T231RPT.

           MOVE 'A130' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                DELETE FROM D231.T231RPT
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       A140-DELETE-T231LINE.

           MOVE 'A140' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                DELETE FROM D231.T231LINE
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       A150-DELETE-T231COL.

           MOVE 'A150' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                DELETE FROM D231.T231COL
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       A160-DELETE-T231PRIM.

           MOVE 'A160' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                DELETE FROM D231.T231PRIM
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       A170-DELETE-T231ORG.

           MOVE 'A170' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                DELETE FROM D231.T231ORG
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       A180-DELETE-T231RGN.

           MOVE 'A180' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                DELETE FROM D231.T231RGN
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       A190-DELETE-T231MNEM.

           MOVE 'A190' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                DELETE FROM D231.T231MNEM
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       A200-PROCESS-TABLE-INPUT-FILE.

           MOVE 'A200' TO CA-PARAGRAPH-NBR.

           PERFORM A210-READ-DIST-INPUT-RECORD.

           IF  W0000-NOT-END-OF-FILE

               EVALUATE LINK-TABLE-NAME
                   WHEN 'T231DIST'
                        PERFORM B000-PROCESS-T231DIST-RECORD
                   WHEN 'T231BOOK'
                        PERFORM C000-PROCESS-T231BOOK-RECORD
                   WHEN 'T231RPT '
                        PERFORM D000-PROCESS-T231RPT-RECORD
                   WHEN 'T231LINE'
                        PERFORM E000-PROCESS-T231LINE-RECORD
                   WHEN 'T231COL '
                        PERFORM F000-PROCESS-T231COL-RECORD
                   WHEN 'T231PRIM'
                        PERFORM G000-PROCESS-T231PRIM-RECORD
                   WHEN 'T231ORG '
                        PERFORM H000-PROCESS-T231ORG-RECORD
                   WHEN 'T231RGN '
                        PERFORM I000-PROCESS-T231RGN-RECORD
                   WHEN 'T231MNEM'
                        PERFORM J000-PROCESS-T231MNEM-RECORD
                   WHEN OTHER
                        DISPLAY ' ###################################'
                        DISPLAY ' ##  INVALID PARM VALUE RECEIVED  ##'
                        DISPLAY ' ###################################'
                        SET W0000-END-OF-FILE TO TRUE
               END-EVALUATE
           END-IF.

           EJECT
       A210-READ-DIST-INPUT-RECORD.

           MOVE 'A210' TO CA-PARAGRAPH-NBR.

           READ TABLE-INPUT-FILE INTO W0001-INPUT-RECORD
               AT END  SET W0000-END-OF-FILE TO TRUE.

           IF  W0000-NOT-END-OF-FILE
               DISPLAY ' INPUT=' W0001-T231DIST
               ADD +1 TO W0000-INPUT-CTR
           END-IF.

           EJECT
       A300-TERMINATION.

           MOVE 'A300' TO CA-PARAGRAPH-NBR.

           CLOSE TABLE-INPUT-FILE.

           MOVE W0000-INPUT-CTR TO W0000-OUTPUT-DISPLAY.
           DISPLAY '   # OF RECORDS READ    :' W0000-OUTPUT-DISPLAY.

           MOVE W0000-OUTPUT-CTR TO W0000-OUTPUT-DISPLAY.
           DISPLAY '   # OF RECORDS INSERTED:' W0000-OUTPUT-DISPLAY.

           DISPLAY ' **======================================**'.
           DISPLAY ' **  PROGRAM P231F90 - END EXECUTION    **'.
           DISPLAY ' **======================================**'.

           EJECT
       B000-PROCESS-T231DIST-RECORD.

           MOVE 'B000' TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231DIST.

           EVALUATE TRUE
               WHEN W0001-T231DIST-COMMENT-REC
                    MOVE W0001-T231DIST
                      TO W0000-PREV-COMMENT (W0000-IX)
                    SET W0000-COMMENT-FOUND TO TRUE
                    ADD +1                  TO W0000-IX
               WHEN W0001-T231DIST-REC-TYPE-1
                    IF  W0000-COMMENT-FOUND
                        PERFORM B100-BUILD-COMMENT-REC
                            VARYING W0000-IX FROM 1 BY 1
                              UNTIL W0000-IX > W0000-LIMIT
                                 OR W0000-PREV-COMMENT (W0000-IX)
                                    EQUAL SPACES
                        SET W0000-NO-COMMENT-FOUND TO TRUE
                        MOVE +1                    TO W0000-IX
                        INITIALIZE W0000-COMMENT-TABLE
                    END-IF

                    PERFORM B200-BUILD-REC-TYPE-1
               WHEN W0001-T231DIST-REC-TYPE-2
                    PERFORM B300-BUILD-REC-TYPE-2
           END-EVALUATE.

           IF  W0001-T231DIST-COMMENT-REC
               CONTINUE
           ELSE
               PERFORM B400-INSERT-T231DIST

               IF  DB2-DUPLICATE-KEY
                   PERFORM B500-INSERT-T231DIST
               END-IF
           END-IF.

           EJECT
       B100-BUILD-COMMENT-REC.

           MOVE 'B100' TO CA-PARAGRAPH-NBR.

           MOVE LINK-DIST-ID
             TO F-DSID-C          IN DCLT231DIST.

           IF  W0000-COMMENT-CTR EQUAL ZEROES
               MOVE 'XX'
                 TO F-DSLN-N      IN DCLT231DIST
           ELSE
               MOVE W0001-F-DSLN-N
                 TO F-DSLN-N      IN DCLT231DIST
           END-IF.

           MOVE '/'
             TO DB-RECTYP-C       IN DCLT231DIST.
           MOVE +1
             TO A-SEQ-N           IN DCLT231DIST.
           MOVE W0000-PREV-COMMENT-X (W0000-IX)
             TO F-DSID-X          IN DCLT231DIST.

           PERFORM B400-INSERT-T231DIST.

           IF  DB2-DUPLICATE-KEY
               PERFORM B500-INSERT-T231DIST
           END-IF.

           INITIALIZE DCLT231DIST.

           ADD +1  TO W0000-COMMENT-CTR.

           EJECT
       B200-BUILD-REC-TYPE-1.

           MOVE 'B200' TO CA-PARAGRAPH-NBR.

           MOVE LINK-DIST-ID
             TO F-DSID-C          IN DCLT231DIST.
           MOVE W0001-F-DSLN-N
             TO F-DSLN-N          IN DCLT231DIST.
           MOVE W0001-DB-RECTYP-C
             TO DB-RECTYP-C       IN DCLT231DIST.
           MOVE +1
             TO A-SEQ-N           IN DCLT231DIST.
           MOVE W0001-F-DSID-X
             TO F-DSID-X          IN DCLT231DIST.

           EJECT
       B300-BUILD-REC-TYPE-2.

           MOVE 'B300' TO CA-PARAGRAPH-NBR.

           MOVE LINK-DIST-ID
             TO F-DSID-C          IN DCLT231DIST.
           MOVE W0001-F-DSLN-N
             TO F-DSLN-N          IN DCLT231DIST.
           MOVE W0001-DB-RECTYP-C
             TO DB-RECTYP-C       IN DCLT231DIST.
           MOVE +1
             TO A-SEQ-N           IN DCLT231DIST.
           MOVE SPACES
             TO F-DSID-X          IN DCLT231DIST.

           MOVE W0001-F-BKID01-C
             TO F-BKID01-C        IN DCLT231DIST.
           MOVE W0001-F-BKID02-C
             TO F-BKID02-C        IN DCLT231DIST.
           MOVE W0001-F-BKID03-C
             TO F-BKID03-C        IN DCLT231DIST.
           MOVE W0001-F-BKID04-C
             TO F-BKID04-C        IN DCLT231DIST.
           MOVE W0001-F-BKID05-C
             TO F-BKID05-C        IN DCLT231DIST.
           MOVE W0001-F-BKID06-C
             TO F-BKID06-C        IN DCLT231DIST.
           MOVE W0001-F-BKID07-C
             TO F-BKID07-C        IN DCLT231DIST.
           MOVE W0001-F-BKID08-C
             TO F-BKID08-C        IN DCLT231DIST.
           MOVE W0001-F-BKID09-C
             TO F-BKID09-C        IN DCLT231DIST.

           MOVE W0001-A-CPY01-N
             TO A-CPY01-N         IN DCLT231DIST.
           MOVE W0001-A-CPY02-N
             TO A-CPY02-N         IN DCLT231DIST.
           MOVE W0001-A-CPY03-N
             TO A-CPY03-N         IN DCLT231DIST.
           MOVE W0001-A-CPY04-N
             TO A-CPY04-N         IN DCLT231DIST.
           MOVE W0001-A-CPY05-N
             TO A-CPY05-N         IN DCLT231DIST.
           MOVE W0001-A-CPY06-N
             TO A-CPY06-N         IN DCLT231DIST.
           MOVE W0001-A-CPY07-N
             TO A-CPY07-N         IN DCLT231DIST.
           MOVE W0001-A-CPY08-N
             TO A-CPY08-N         IN DCLT231DIST.
           MOVE W0001-A-CPY09-N
             TO A-CPY09-N         IN DCLT231DIST.

           MOVE W0001-F-BRST01-I
             TO F-BRST01-C        IN DCLT231DIST.
           MOVE W0001-F-BRST02-I
             TO F-BRST02-C        IN DCLT231DIST.
           MOVE W0001-F-BRST03-I
             TO F-BRST03-C        IN DCLT231DIST.
           MOVE W0001-F-BRST04-I
             TO F-BRST04-C        IN DCLT231DIST.
           MOVE W0001-F-BRST05-I
             TO F-BRST05-C        IN DCLT231DIST.
           MOVE W0001-F-BRST06-I
             TO F-BRST06-C        IN DCLT231DIST.
           MOVE W0001-F-BRST07-I
             TO F-BRST07-C        IN DCLT231DIST.
           MOVE W0001-F-BRST08-I
             TO F-BRST08-C        IN DCLT231DIST.
           MOVE W0001-F-BRST09-I
             TO F-BRST09-C        IN DCLT231DIST.

           EJECT
       B400-INSERT-T231DIST.

           MOVE 'B400' TO CA-PARAGRAPH-NBR.

           EXEC SQL
             INSERT INTO D231.T231DIST
                 ( F_DSID_C
                 , F_DSLN_N
                 , DB_RECTYP_C
                 , A_SEQ_N
                 , F_DSID_X
                 , F_BKID01_C
                 , F_BKID02_C
                 , F_BKID03_C
                 , F_BKID04_C
                 , F_BKID05_C
                 , F_BKID06_C
                 , F_BKID07_C
                 , F_BKID08_C
                 , F_BKID09_C
                 , A_CPY01_N
                 , A_CPY02_N
                 , A_CPY03_N
                 , A_CPY04_N
                 , A_CPY05_N
                 , A_CPY06_N
                 , A_CPY07_N
                 , A_CPY08_N
                 , A_CPY09_N
                 , F_BRST01_C
                 , F_BRST02_C
                 , F_BRST03_C
                 , F_BRST04_C
                 , F_BRST05_C
                 , F_BRST06_C
                 , F_BRST07_C
                 , F_BRST08_C
                 , F_BRST09_C
                 , DB_UPD_D
                 , DB_UPD_T )
             VALUES
                 ( :DCLT231DIST.F-DSID-C
                 , :DCLT231DIST.F-DSLN-N
                 , :DCLT231DIST.DB-RECTYP-C
                 , :DCLT231DIST.A-SEQ-N
                 , :DCLT231DIST.F-DSID-X
                 , :DCLT231DIST.F-BKID01-C
                 , :DCLT231DIST.F-BKID02-C
                 , :DCLT231DIST.F-BKID03-C
                 , :DCLT231DIST.F-BKID04-C
                 , :DCLT231DIST.F-BKID05-C
                 , :DCLT231DIST.F-BKID06-C
                 , :DCLT231DIST.F-BKID07-C
                 , :DCLT231DIST.F-BKID08-C
                 , :DCLT231DIST.F-BKID09-C
                 , :DCLT231DIST.A-CPY01-N
                 , :DCLT231DIST.A-CPY02-N
                 , :DCLT231DIST.A-CPY03-N
                 , :DCLT231DIST.A-CPY04-N
                 , :DCLT231DIST.A-CPY05-N
                 , :DCLT231DIST.A-CPY06-N
                 , :DCLT231DIST.A-CPY07-N
                 , :DCLT231DIST.A-CPY08-N
                 , :DCLT231DIST.A-CPY09-N
                 , :DCLT231DIST.F-BRST01-C
                 , :DCLT231DIST.F-BRST02-C
                 , :DCLT231DIST.F-BRST03-C
                 , :DCLT231DIST.F-BRST04-C
                 , :DCLT231DIST.F-BRST05-C
                 , :DCLT231DIST.F-BRST06-C
                 , :DCLT231DIST.F-BRST07-C
                 , :DCLT231DIST.F-BRST08-C
                 , :DCLT231DIST.F-BRST09-C
                 , CURRENT DATE
                 , CURRENT TIME )
           END-EXEC.

           SET DUP-KEY        TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               ADD +1 TO W0000-OUTPUT-CTR
           END-IF.

           EJECT
       B500-INSERT-T231DIST.

           MOVE 'B500' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                SELECT (MAX(A_SEQ_N) +1)
                  INTO :DCLT231DIST.A-SEQ-N
                  FROM D231.T231DIST
                 WHERE F_DSID_C      = :DCLT231DIST.F-DSID-C
                   AND F_DSLN_N      = :DCLT231DIST.F-DSLN-N
                   AND DB_RECTYP_C   = :DCLT231DIST.DB-RECTYP-C
           END-EXEC.

           SET NORMAL-RC-ONLY TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM B400-INSERT-T231DIST.

           EJECT
       C000-PROCESS-T231BOOK-RECORD.

           MOVE 'C000' TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231BOOK.

           EVALUATE TRUE
               WHEN W0001-T231BOOK-COMMENT-REC
                    MOVE W0001-T231BOOK
                      TO W0000-PREV-COMMENT (W0000-IX)
                    SET W0000-COMMENT-FOUND TO TRUE
                    ADD +1                  TO W0000-IX
               WHEN W0001-T231BOOK-REC-TYPE-1
                    IF  W0001-F-BKID-C NOT EQUAL W0000-PREV-BOOK-ID
                        MOVE W0001-F-BKID-C TO W0000-PREV-BOOK-ID
                        MOVE ZEROES         TO W0000-SEQ-NBR
                        MOVE ZEROES         TO W0000-RPT-NBR
      *  EACH BOOK MUST HAVE A COMMENT FOR USE IN THE ON-LINE SCREEN
      *  LISTING DESCRIPTION.  IF NO COMMENTS EXIST FOR THE BOOK
      *  CREATE ONE FROM THE FIRST TYPE 1 RECORD.
                        IF  W0000-COMMENT-FOUND
                            CONTINUE
                        ELSE
                            MOVE W0001-T231BOOK (1:79)
                              TO W0000-PREV-COMMENT (W0000-IX) (2:79)
                            SET W0000-COMMENT-FOUND TO TRUE
                            ADD +1                  TO W0000-IX
                        END-IF
                    END-IF

                    IF  W0000-COMMENT-FOUND
                        PERFORM C100-BUILD-COMMENT-REC
                            VARYING W0000-IX FROM 1 BY 1
                              UNTIL W0000-IX > W0000-LIMIT
                                 OR W0000-PREV-COMMENT (W0000-IX)
                                    EQUAL SPACES
                        SET W0000-NO-COMMENT-FOUND TO TRUE
                        MOVE +1                    TO W0000-IX
                        INITIALIZE W0000-COMMENT-TABLE
                    END-IF
                    PERFORM C200-BUILD-REC-TYPE-1
                    SET W0000-LAST-REC-WAS-OLD-GROUP TO TRUE
               WHEN W0001-T231BOOK-REC-TYPE-2
                    IF  W0000-COMMENT-FOUND
                        PERFORM C100-BUILD-COMMENT-REC
                            VARYING W0000-IX FROM 1 BY 1
                              UNTIL W0000-IX > W0000-LIMIT
                                 OR W0000-PREV-COMMENT (W0000-IX)
                                    EQUAL SPACES
                        SET W0000-NO-COMMENT-FOUND TO TRUE
                        MOVE +1                    TO W0000-IX
                        INITIALIZE W0000-COMMENT-TABLE
                    END-IF

                    IF  W0000-LAST-REC-WAS-NEW-GROUP
                        CONTINUE
                    ELSE
                        SET W0000-LAST-REC-WAS-NEW-GROUP TO TRUE
                        MOVE ZEROES  TO W0000-SEQ-NBR
                        ADD 1        TO W0000-RPT-NBR
                    END-IF

                    PERFORM C300-BUILD-REC-TYPE-2
               WHEN W0001-T231BOOK-REC-TYPE-3
                    IF  W0000-COMMENT-FOUND
                        PERFORM C100-BUILD-COMMENT-REC
                            VARYING W0000-IX FROM 1 BY 1
                              UNTIL W0000-IX > W0000-LIMIT
                                 OR W0000-PREV-COMMENT (W0000-IX)
                                    EQUAL SPACES
                        SET W0000-NO-COMMENT-FOUND TO TRUE
                        MOVE +1                    TO W0000-IX
                        INITIALIZE W0000-COMMENT-TABLE
                    END-IF

                    IF  W0000-LAST-REC-WAS-NEW-GROUP
                        SET W0000-LAST-REC-WAS-OLD-GROUP TO TRUE
                    ELSE
                        SET W0000-LAST-REC-WAS-NEW-GROUP TO TRUE
                        MOVE ZEROES  TO W0000-SEQ-NBR
                        ADD 1        TO W0000-RPT-NBR
                    END-IF
                    PERFORM C400-BUILD-REC-TYPE-3
                    SET W0000-LAST-REC-WAS-OLD-GROUP TO TRUE
               WHEN W0001-T231BOOK-REC-TYPE-4
                    IF  W0000-COMMENT-FOUND
                        PERFORM C100-BUILD-COMMENT-REC
                            VARYING W0000-IX FROM 1 BY 1
                              UNTIL W0000-IX > W0000-LIMIT
                                 OR W0000-PREV-COMMENT (W0000-IX)
                                    EQUAL SPACES
                        SET W0000-NO-COMMENT-FOUND TO TRUE
                        MOVE +1                    TO W0000-IX
                        INITIALIZE W0000-COMMENT-TABLE
                    END-IF

                    PERFORM C500-BUILD-REC-TYPE-4
                    SET W0000-LAST-REC-WAS-OLD-GROUP TO TRUE
               WHEN W0001-T231BOOK-REC-TYPE-5
                    IF  W0000-COMMENT-FOUND
                        PERFORM C100-BUILD-COMMENT-REC
                            VARYING W0000-IX FROM 1 BY 1
                              UNTIL W0000-IX > W0000-LIMIT
                                 OR W0000-PREV-COMMENT (W0000-IX)
                                    EQUAL SPACES
                        SET W0000-NO-COMMENT-FOUND TO TRUE
                        MOVE +1                    TO W0000-IX
                        INITIALIZE W0000-COMMENT-TABLE
                    END-IF

                    PERFORM C600-BUILD-REC-TYPE-5
                    SET W0000-LAST-REC-WAS-OLD-GROUP TO TRUE
               WHEN W0001-T231BOOK-REC-TYPE-6
                    IF  W0000-COMMENT-FOUND
                        PERFORM C100-BUILD-COMMENT-REC
                            VARYING W0000-IX FROM 1 BY 1
                              UNTIL W0000-IX > W0000-LIMIT
                                 OR W0000-PREV-COMMENT (W0000-IX)
                                    EQUAL SPACES
                        SET W0000-NO-COMMENT-FOUND TO TRUE
                        MOVE +1                    TO W0000-IX
                        INITIALIZE W0000-COMMENT-TABLE
                    END-IF

                    PERFORM C700-BUILD-REC-TYPE-6
                    SET W0000-LAST-REC-WAS-OLD-GROUP TO TRUE
           END-EVALUATE.

           IF  W0001-T231RPT-COMMENT-REC
               CONTINUE
           ELSE
               PERFORM C800-INSERT-T231BOOK

               IF  DB2-DUPLICATE-KEY
                   PERFORM C900-INSERT-T231BOOK
               END-IF
           END-IF.

           EJECT
       C100-BUILD-COMMENT-REC.

           MOVE 'C100' TO CA-PARAGRAPH-NBR.

           MOVE W0001-F-BKID-C
             TO F-BKID-C          IN DCLT231BOOK.
           ADD +1                 TO W0000-SEQ-NBR
           MOVE W0000-SEQ-NBR
             TO A-SEQ-N           IN DCLT231BOOK.

           IF  W0000-RPT-NBR NOT EQUAL ZEROES
               MOVE W0000-RPT-NBR
                 TO F-RPTGRP-C    IN DCLT231BOOK
           END-IF.

           MOVE '/'
             TO DB-RECTYP-C       IN DCLT231BOOK.
           MOVE W0000-PREV-COMMENT-X (W0000-IX)
             TO F-BKID-X          IN DCLT231BOOK.

           PERFORM C800-INSERT-T231BOOK.

           IF  DB2-DUPLICATE-KEY
               PERFORM C900-INSERT-T231BOOK
           END-IF.

           INITIALIZE DCLT231BOOK.

           EJECT
       C200-BUILD-REC-TYPE-1.

           MOVE 'C200' TO CA-PARAGRAPH-NBR.

           MOVE W0001-F-BKID-C
             TO F-BKID-C          IN DCLT231BOOK.
           MOVE W0001-BK-RECTYP-C
             TO DB-RECTYP-C       IN DCLT231BOOK.
           ADD +1                 TO W0000-SEQ-NBR
           MOVE W0000-SEQ-NBR
             TO A-SEQ-N           IN DCLT231BOOK.
           MOVE W0001-F-TBL-C
             TO F-TBL-C           IN DCLT231BOOK.
           MOVE W0001-F-BKID-X01
             TO F-BKID-X          IN DCLT231BOOK.

           EJECT
       C300-BUILD-REC-TYPE-2.

           MOVE 'C300' TO CA-PARAGRAPH-NBR.

           MOVE W0001-F-BKID-C
             TO F-BKID-C          IN DCLT231BOOK.
           MOVE W0001-BK-RECTYP-C
             TO DB-RECTYP-C       IN DCLT231BOOK.
           MOVE W0000-RPT-NBR
             TO F-RPTGRP-C        IN DCLT231BOOK.
           ADD +1                 TO W0000-SEQ-NBR
           MOVE W0000-SEQ-NBR
             TO A-SEQ-N           IN DCLT231BOOK.
           MOVE W0001-F-BKID-X02
             TO F-BKID-X          IN DCLT231BOOK.
           MOVE W0001-A-PGCNT-N
             TO A-PGCNT-N         IN DCLT231BOOK.

           EJECT
       C400-BUILD-REC-TYPE-3.

           MOVE 'C400' TO CA-PARAGRAPH-NBR.

           MOVE W0001-F-BKID-C
             TO F-BKID-C          IN DCLT231BOOK.
           MOVE W0001-BK-RECTYP-C
             TO DB-RECTYP-C       IN DCLT231BOOK.
           MOVE W0000-RPT-NBR
             TO F-RPTGRP-C        IN DCLT231BOOK.
           ADD +1                 TO W0000-SEQ-NBR
           MOVE W0000-SEQ-NBR
             TO A-SEQ-N           IN DCLT231BOOK.
           MOVE W0001-F-PRNT-C
             TO F-TBL-C           IN DCLT231BOOK.
           MOVE W0001-F-RPT01-C
             TO F-RPT01-C         IN DCLT231BOOK.
           MOVE W0001-F-RPT02-C
             TO F-RPT02-C         IN DCLT231BOOK.
           MOVE W0001-F-RPT03-C
             TO F-RPT03-C         IN DCLT231BOOK.
           MOVE W0001-F-RPT04-C
             TO F-RPT04-C         IN DCLT231BOOK.
           MOVE W0001-F-RPT05-C
             TO F-RPT05-C         IN DCLT231BOOK.
           MOVE W0001-F-RPT06-C
             TO F-RPT06-C         IN DCLT231BOOK.
           MOVE W0001-F-RPT07-C
             TO F-RPT07-C         IN DCLT231BOOK.
           MOVE W0001-F-RPT08-C
             TO F-RPT08-C         IN DCLT231BOOK.
           MOVE W0001-F-RPT09-C
             TO F-RPT09-C         IN DCLT231BOOK.
           MOVE W0001-F-RPT10-C
             TO F-RPT10-C         IN DCLT231BOOK.
           MOVE W0001-F-RPT11-C
             TO F-RPT11-C         IN DCLT231BOOK.
           MOVE W0001-F-RPT12-C
             TO F-RPT12-C         IN DCLT231BOOK.
           MOVE W0001-F-RPT13-C
             TO F-RPT13-C         IN DCLT231BOOK.
           MOVE W0001-F-RPT14-C
             TO F-RPT14-C         IN DCLT231BOOK.
           MOVE W0001-F-RPT15-C
             TO F-RPT15-C         IN DCLT231BOOK.
           MOVE W0001-F-RPT16-C
             TO F-RPT16-C         IN DCLT231BOOK.
           MOVE W0001-F-RPT17-C
             TO F-RPT17-C         IN DCLT231BOOK.
           MOVE W0001-F-RPT18-C
             TO F-RPT18-C         IN DCLT231BOOK.

           EJECT
       C500-BUILD-REC-TYPE-4.

           MOVE 'C500' TO CA-PARAGRAPH-NBR.

           MOVE W0001-F-BKID-C
             TO F-BKID-C          IN DCLT231BOOK.
           MOVE W0001-BK-RECTYP-C
             TO DB-RECTYP-C       IN DCLT231BOOK.
           MOVE W0000-RPT-NBR
             TO F-RPTGRP-C        IN DCLT231BOOK.
           ADD +1                 TO W0000-SEQ-NBR
           MOVE W0000-SEQ-NBR
             TO A-SEQ-N           IN DCLT231BOOK.

           IF  W0001-F-PRTLVL01-C1 NOT EQUAL 'TOT'
               SET W0000-PRIME-SEQ TO TRUE
               MOVE W0001-F-PRMACCT-C01
                 TO F-RPT01-C         IN DCLT231BOOK
               MOVE W0001-F-PRMACCT-C02
                 TO F-RPT02-C         IN DCLT231BOOK
               MOVE W0001-F-PRMACCT-C03
                 TO F-RPT03-C         IN DCLT231BOOK
               MOVE W0001-F-PRMACCT-C04
                 TO F-RPT04-C         IN DCLT231BOOK
               MOVE W0001-F-PRMACCT-C05
                 TO F-RPT05-C         IN DCLT231BOOK
               MOVE W0001-F-PRMACCT-C06
                 TO F-RPT06-C         IN DCLT231BOOK
               MOVE W0001-F-PRMACCT-C07
                 TO F-RPT07-C         IN DCLT231BOOK
               MOVE W0001-F-PRMACCT-C08
                 TO F-RPT08-C         IN DCLT231BOOK
           ELSE
               SET W0000-NOT-PRIME-SEQ TO TRUE
               MOVE W0001-F-PRTLVL01-C1
                 TO F-RPT01-C         IN DCLT231BOOK
               MOVE W0001-F-PRTLVL02-C1
                 TO F-RPT02-C         IN DCLT231BOOK
               MOVE W0001-F-PRTLVL03-C1
                 TO F-RPT03-C         IN DCLT231BOOK
               MOVE W0001-F-PRTLVL04-C1
                 TO F-RPT04-C         IN DCLT231BOOK
               MOVE W0001-F-PRTLVL05-C1
                 TO F-RPT05-C         IN DCLT231BOOK
               MOVE W0001-F-PRTLVL06-C1
                 TO F-RPT06-C         IN DCLT231BOOK
               MOVE W0001-F-PRTLVL07-C1
                 TO F-RPT07-C         IN DCLT231BOOK
               MOVE W0001-F-PRTLVL08-C1
                 TO F-RPT08-C         IN DCLT231BOOK
               MOVE W0001-F-PRTLVL09-C1
                 TO F-RPT09-C         IN DCLT231BOOK
               MOVE W0001-F-PRTLVL10-C1
                 TO F-RPT10-C         IN DCLT231BOOK
               MOVE W0001-F-PRTLVL11-C1
                 TO F-RPT11-C         IN DCLT231BOOK
           END-IF.

           MOVE W0001-F-PRTLVL01-C2
             TO F-RPT12-C         IN DCLT231BOOK.
           MOVE W0001-F-PRTLVL02-C2
             TO F-RPT13-C         IN DCLT231BOOK.
           MOVE W0001-F-PRTLVL03-C2
             TO F-RPT14-C         IN DCLT231BOOK.
           MOVE W0001-F-PRTLVL04-C2
             TO F-RPT15-C         IN DCLT231BOOK.
           MOVE W0001-F-PRTLVL05-C2
             TO F-RPT16-C         IN DCLT231BOOK.
           MOVE W0001-F-PRTLVL06-C2
             TO F-RPT17-C         IN DCLT231BOOK.
           MOVE W0001-F-PRTLVL07-C2
             TO F-RPT18-C         IN DCLT231BOOK.
           MOVE W0001-F-PRTLVL08-C2
             TO F-RPT19-C         IN DCLT231BOOK.
           MOVE W0001-F-PRTLVL09-C2
             TO F-RPT20-C         IN DCLT231BOOK.
           MOVE W0001-F-PRTLVL10-C2
             TO F-RPT21-C         IN DCLT231BOOK.
           MOVE W0001-F-PRTLVL11-C2
             TO F-RPT22-C         IN DCLT231BOOK.


           EJECT
       C600-BUILD-REC-TYPE-5.

           MOVE 'C600' TO CA-PARAGRAPH-NBR.

           MOVE W0001-F-BKID-C
             TO F-BKID-C          IN DCLT231BOOK.
           MOVE W0001-BK-RECTYP-C
             TO DB-RECTYP-C       IN DCLT231BOOK.
           MOVE W0000-RPT-NBR
             TO F-RPTGRP-C        IN DCLT231BOOK.
           ADD +1                 TO W0000-SEQ-NBR
           MOVE W0000-SEQ-NBR
             TO A-SEQ-N           IN DCLT231BOOK.

           IF  W0000-PRIME-SEQ
               MOVE W0001-F-PRMACCT-C01
                 TO F-RPT01-C         IN DCLT231BOOK
               MOVE W0001-F-PRMACCT-C02
                 TO F-RPT02-C         IN DCLT231BOOK
               MOVE W0001-F-PRMACCT-C03
                 TO F-RPT03-C         IN DCLT231BOOK
               MOVE W0001-F-PRMACCT-C04
                 TO F-RPT04-C         IN DCLT231BOOK
               MOVE W0001-F-PRMACCT-C05
                 TO F-RPT05-C         IN DCLT231BOOK
               MOVE W0001-F-PRMACCT-C06
                 TO F-RPT06-C         IN DCLT231BOOK
               MOVE W0001-F-PRMACCT-C07
                 TO F-RPT07-C         IN DCLT231BOOK
               MOVE W0001-F-PRMACCT-C08
                 TO F-RPT08-C         IN DCLT231BOOK
           ELSE
               MOVE W0001-F-PRTSEQ01-C1
                 TO F-RPT01-C         IN DCLT231BOOK
               MOVE W0001-F-PRTSEQ02-C1
                 TO F-RPT02-C         IN DCLT231BOOK
               MOVE W0001-F-PRTSEQ03-C1
                 TO F-RPT03-C         IN DCLT231BOOK
               MOVE W0001-F-PRTSEQ04-C1
                 TO F-RPT04-C         IN DCLT231BOOK
               MOVE W0001-F-PRTSEQ05-C1
                 TO F-RPT05-C         IN DCLT231BOOK
               MOVE W0001-F-PRTSEQ06-C1
                 TO F-RPT06-C         IN DCLT231BOOK
               MOVE W0001-F-PRTSEQ07-C1
                 TO F-RPT07-C         IN DCLT231BOOK
               MOVE W0001-F-PRTSEQ08-C1
                 TO F-RPT08-C         IN DCLT231BOOK
               MOVE W0001-F-PRTSEQ09-C1
                 TO F-RPT09-C         IN DCLT231BOOK
               MOVE W0001-F-PRTSEQ10-C1
                 TO F-RPT10-C         IN DCLT231BOOK
               MOVE W0001-F-PRTSEQ11-C1
                 TO F-RPT11-C         IN DCLT231BOOK
           END-IF.

           MOVE W0001-F-PRTSEQ01-C2
             TO F-RPT12-C         IN DCLT231BOOK.
           MOVE W0001-F-PRTSEQ02-C2
             TO F-RPT13-C         IN DCLT231BOOK.
           MOVE W0001-F-PRTSEQ03-C2
             TO F-RPT14-C         IN DCLT231BOOK.
           MOVE W0001-F-PRTSEQ04-C2
             TO F-RPT15-C         IN DCLT231BOOK.
           MOVE W0001-F-PRTSEQ05-C2
             TO F-RPT16-C         IN DCLT231BOOK.
           MOVE W0001-F-PRTSEQ06-C2
             TO F-RPT17-C         IN DCLT231BOOK.
           MOVE W0001-F-PRTSEQ07-C2
             TO F-RPT18-C         IN DCLT231BOOK.
           MOVE W0001-F-PRTSEQ08-C2
             TO F-RPT19-C         IN DCLT231BOOK.
           MOVE W0001-F-PRTSEQ09-C2
             TO F-RPT20-C         IN DCLT231BOOK.
           MOVE W0001-F-PRTSEQ10-C2
             TO F-RPT21-C         IN DCLT231BOOK.
           MOVE W0001-F-PRTSEQ11-C2
             TO F-RPT22-C         IN DCLT231BOOK.

           EJECT
       C700-BUILD-REC-TYPE-6.

           MOVE 'C700' TO CA-PARAGRAPH-NBR.

           MOVE W0001-F-BKID-C
             TO F-BKID-C          IN DCLT231BOOK.
           MOVE W0001-BK-RECTYP-C
             TO DB-RECTYP-C       IN DCLT231BOOK.
           MOVE W0000-RPT-NBR
             TO F-RPTGRP-C        IN DCLT231BOOK.
           ADD +1                 TO W0000-SEQ-NBR
           MOVE W0000-SEQ-NBR
             TO A-SEQ-N           IN DCLT231BOOK.

           MOVE W0001-F-ALTSEQ01-C1
             TO F-RPT01-C         IN DCLT231BOOK.
           MOVE W0001-F-ALTSEQ02-C1
             TO F-RPT02-C         IN DCLT231BOOK.
           MOVE W0001-F-ALTSEQ03-C1
             TO F-RPT03-C         IN DCLT231BOOK.
           MOVE W0001-F-ALTSEQ04-C1
             TO F-RPT04-C         IN DCLT231BOOK.
           MOVE W0001-F-ALTSEQ05-C1
             TO F-RPT05-C         IN DCLT231BOOK.
           MOVE W0001-F-ALTSEQ06-C1
             TO F-RPT06-C         IN DCLT231BOOK.
           MOVE W0001-F-ALTSEQ07-C1
             TO F-RPT07-C         IN DCLT231BOOK.
           MOVE W0001-F-ALTSEQ08-C1
             TO F-RPT08-C         IN DCLT231BOOK.
           MOVE W0001-F-ALTSEQ09-C1
             TO F-RPT09-C         IN DCLT231BOOK.
           MOVE W0001-F-ALTSEQ10-C1
             TO F-RPT10-C         IN DCLT231BOOK.
           MOVE W0001-F-ALTSEQ11-C1
             TO F-RPT11-C         IN DCLT231BOOK.

           MOVE W0001-F-ALTSEQ01-C2
             TO F-RPT12-C         IN DCLT231BOOK.
           MOVE W0001-F-ALTSEQ02-C2
             TO F-RPT13-C         IN DCLT231BOOK.
           MOVE W0001-F-ALTSEQ03-C2
             TO F-RPT14-C         IN DCLT231BOOK.
           MOVE W0001-F-ALTSEQ04-C2
             TO F-RPT15-C         IN DCLT231BOOK.
           MOVE W0001-F-ALTSEQ05-C2
             TO F-RPT16-C         IN DCLT231BOOK.
           MOVE W0001-F-ALTSEQ06-C2
             TO F-RPT17-C         IN DCLT231BOOK.
           MOVE W0001-F-ALTSEQ07-C2
             TO F-RPT18-C         IN DCLT231BOOK.
           MOVE W0001-F-ALTSEQ08-C2
             TO F-RPT19-C         IN DCLT231BOOK.
           MOVE W0001-F-ALTSEQ09-C2
             TO F-RPT20-C         IN DCLT231BOOK.
           MOVE W0001-F-ALTSEQ10-C2
             TO F-RPT21-C         IN DCLT231BOOK.
           MOVE W0001-F-ALTSEQ11-C2
             TO F-RPT22-C         IN DCLT231BOOK.

           EJECT
       C800-INSERT-T231BOOK.

           MOVE 'C800' TO CA-PARAGRAPH-NBR.

           EXEC SQL
             INSERT INTO D231.T231BOOK
                 ( F_BKID_C
                 , F_RPTGRP_C
                 , A_SEQ_N
                 , DB_RECTYP_C
                 , F_BKID_X
                 , F_TBL_C
                 , A_PGCNT_N
                 , F_RPT01_C
                 , F_RPT02_C
                 , F_RPT03_C
                 , F_RPT04_C
                 , F_RPT05_C
                 , F_RPT06_C
                 , F_RPT07_C
                 , F_RPT08_C
                 , F_RPT09_C
                 , F_RPT10_C
                 , F_RPT11_C
                 , F_RPT12_C
                 , F_RPT13_C
                 , F_RPT14_C
                 , F_RPT15_C
                 , F_RPT16_C
                 , F_RPT17_C
                 , F_RPT18_C
                 , F_RPT19_C
                 , F_RPT20_C
                 , F_RPT21_C
                 , F_RPT22_C
                 , DB_UPD_D
                 , DB_UPD_T )
             VALUES
                 ( :DCLT231BOOK.F-BKID-C
                 , :DCLT231BOOK.F-RPTGRP-C
                 , :DCLT231BOOK.A-SEQ-N
                 , :DCLT231BOOK.DB-RECTYP-C
                 , :DCLT231BOOK.F-BKID-X
                 , :DCLT231BOOK.F-TBL-C
                 , :DCLT231BOOK.A-PGCNT-N
                 , :DCLT231BOOK.F-RPT01-C
                 , :DCLT231BOOK.F-RPT02-C
                 , :DCLT231BOOK.F-RPT03-C
                 , :DCLT231BOOK.F-RPT04-C
                 , :DCLT231BOOK.F-RPT05-C
                 , :DCLT231BOOK.F-RPT06-C
                 , :DCLT231BOOK.F-RPT07-C
                 , :DCLT231BOOK.F-RPT08-C
                 , :DCLT231BOOK.F-RPT09-C
                 , :DCLT231BOOK.F-RPT10-C
                 , :DCLT231BOOK.F-RPT11-C
                 , :DCLT231BOOK.F-RPT12-C
                 , :DCLT231BOOK.F-RPT13-C
                 , :DCLT231BOOK.F-RPT14-C
                 , :DCLT231BOOK.F-RPT15-C
                 , :DCLT231BOOK.F-RPT16-C
                 , :DCLT231BOOK.F-RPT17-C
                 , :DCLT231BOOK.F-RPT18-C
                 , :DCLT231BOOK.F-RPT19-C
                 , :DCLT231BOOK.F-RPT20-C
                 , :DCLT231BOOK.F-RPT21-C
                 , :DCLT231BOOK.F-RPT22-C
                 , CURRENT DATE
                 , CURRENT TIME )
           END-EXEC.

           SET DUP-KEY        TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               ADD +1 TO W0000-OUTPUT-CTR
           END-IF.

           EJECT
       C900-INSERT-T231BOOK.

           MOVE 'C900' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                SELECT (MAX(A_SEQ_N) +1)
                  INTO :DCLT231BOOK.A-SEQ-N
                  FROM D231.T231BOOK
                 WHERE F_BKID_C      = :DCLT231BOOK.F-BKID-C
           END-EXEC.

           SET NORMAL-RC-ONLY TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM C800-INSERT-T231BOOK.

           EJECT
       D000-PROCESS-T231RPT-RECORD.

           MOVE 'D000' TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231RPT.

           EVALUATE TRUE
               WHEN W0001-T231RPT-COMMENT-REC
                    MOVE W0001-T231RPT
                      TO W0000-PREV-COMMENT (W0000-IX)
                    SET W0000-COMMENT-FOUND TO TRUE
                    ADD +1                  TO W0000-IX
               WHEN W0001-T231RPT-REC-TYPE-1
                    IF  W0000-COMMENT-FOUND
                        PERFORM D100-BUILD-COMMENT-REC
                           VARYING W0000-IX FROM 1 BY 1
                             UNTIL W0000-IX > W0000-LIMIT
                                OR W0000-PREV-COMMENT (W0000-IX)
                                   EQUAL SPACES
                        SET W0000-NO-COMMENT-FOUND TO TRUE
                        MOVE +1                    TO W0000-IX
                        INITIALIZE W0000-COMMENT-TABLE
                    END-IF

                    PERFORM D200-BUILD-REC-TYPE-1
               WHEN W0001-T231RPT-REC-TYPE-2
                    IF  W0000-COMMENT-FOUND
                        PERFORM D100-BUILD-COMMENT-REC
                           VARYING W0000-IX FROM 1 BY 1
                             UNTIL W0000-IX > W0000-LIMIT
                                OR W0000-PREV-COMMENT (W0000-IX)
                                   EQUAL SPACES
                        SET W0000-NO-COMMENT-FOUND TO TRUE
                        MOVE +1                    TO W0000-IX
                        INITIALIZE W0000-COMMENT-TABLE
                    END-IF

                    PERFORM D300-BUILD-REC-TYPE-2
               WHEN W0001-T231RPT-REC-TYPE-3
                    IF  W0000-COMMENT-FOUND
                        PERFORM D100-BUILD-COMMENT-REC
                           VARYING W0000-IX FROM 1 BY 1
                             UNTIL W0000-IX > W0000-LIMIT
                                OR W0000-PREV-COMMENT (W0000-IX)
                                   EQUAL SPACES
                        SET W0000-NO-COMMENT-FOUND TO TRUE
                        MOVE +1                    TO W0000-IX
                        INITIALIZE W0000-COMMENT-TABLE
                    END-IF

                    PERFORM D400-BUILD-REC-TYPE-3
               WHEN W0001-T231RPT-REC-TYPE-4
                    IF  W0000-COMMENT-FOUND
                        PERFORM D100-BUILD-COMMENT-REC
                           VARYING W0000-IX FROM 1 BY 1
                             UNTIL W0000-IX > W0000-LIMIT
                                OR W0000-PREV-COMMENT (W0000-IX)
                                   EQUAL SPACES
                        SET W0000-NO-COMMENT-FOUND TO TRUE
                        MOVE +1                    TO W0000-IX
                        INITIALIZE W0000-COMMENT-TABLE
                    END-IF

                    PERFORM D500-BUILD-REC-TYPE-4
               WHEN W0001-T231RPT-REC-TYPE-5
                    IF  W0000-COMMENT-FOUND
                        PERFORM D100-BUILD-COMMENT-REC
                           VARYING W0000-IX FROM 1 BY 1
                             UNTIL W0000-IX > W0000-LIMIT
                                OR W0000-PREV-COMMENT (W0000-IX)
                                   EQUAL SPACES
                        SET W0000-NO-COMMENT-FOUND TO TRUE
                        MOVE +1                    TO W0000-IX
                        INITIALIZE W0000-COMMENT-TABLE
                    END-IF

                    PERFORM D600-BUILD-REC-TYPE-5
               WHEN W0001-T231RPT-REC-TYPE-6
                    IF  W0000-COMMENT-FOUND
                        PERFORM D100-BUILD-COMMENT-REC
                           VARYING W0000-IX FROM 1 BY 1
                             UNTIL W0000-IX > W0000-LIMIT
                                OR W0000-PREV-COMMENT (W0000-IX)
                                   EQUAL SPACES
                        SET W0000-NO-COMMENT-FOUND TO TRUE
                        MOVE +1                    TO W0000-IX
                        INITIALIZE W0000-COMMENT-TABLE
                    END-IF

                    PERFORM D600-BUILD-REC-TYPE-5
               WHEN W0001-T231RPT-REC-TYPE-7
                    IF  W0000-COMMENT-FOUND
                        PERFORM D100-BUILD-COMMENT-REC
                           VARYING W0000-IX FROM 1 BY 1
                             UNTIL W0000-IX > W0000-LIMIT
                                OR W0000-PREV-COMMENT (W0000-IX)
                                   EQUAL SPACES
                        SET W0000-NO-COMMENT-FOUND TO TRUE
                        MOVE +1                    TO W0000-IX
                        INITIALIZE W0000-COMMENT-TABLE
                    END-IF

                    PERFORM D600-BUILD-REC-TYPE-5
               WHEN W0001-T231RPT-REC-TYPE-8
                    IF  W0000-COMMENT-FOUND
                        PERFORM D100-BUILD-COMMENT-REC
                           VARYING W0000-IX FROM 1 BY 1
                             UNTIL W0000-IX > W0000-LIMIT
                                OR W0000-PREV-COMMENT (W0000-IX)
                                   EQUAL SPACES
                        SET W0000-NO-COMMENT-FOUND TO TRUE
                        MOVE +1                    TO W0000-IX
                        INITIALIZE W0000-COMMENT-TABLE
                    END-IF

                    PERFORM D600-BUILD-REC-TYPE-5
           END-EVALUATE.

           IF  W0001-T231RPT-COMMENT-REC
               CONTINUE
           ELSE
               PERFORM D800-INSERT-T231RPT

               IF  DB2-DUPLICATE-KEY
                   PERFORM D900-INSERT-T231RPT
               END-IF
           END-IF.

           EJECT
       D100-BUILD-COMMENT-REC.

           MOVE 'D100' TO CA-PARAGRAPH-NBR.

           MOVE W0001-F-RPTID-C
             TO F-RPTID-C         IN DCLT231RPT.
           MOVE '/'
             TO DB-RECTYP-C       IN DCLT231RPT.
           MOVE +1
             TO A-SEQ-N           IN DCLT231RPT.
           MOVE W0000-PREV-COMMENT-X (W0000-IX)
             TO F-RPTID-X         IN DCLT231RPT.

           PERFORM D800-INSERT-T231RPT.

           IF  DB2-DUPLICATE-KEY
               PERFORM D900-INSERT-T231RPT
           END-IF.

           INITIALIZE DCLT231RPT.

           EJECT
       D200-BUILD-REC-TYPE-1.

           MOVE 'D200' TO CA-PARAGRAPH-NBR.

           MOVE W0001-F-RPTID-C
             TO F-RPTID-C         IN DCLT231RPT.
           MOVE W0001-RPT-RECTYP-C
             TO DB-RECTYP-C       IN DCLT231RPT.
           MOVE +1
             TO A-SEQ-N           IN DCLT231RPT.
           MOVE W0001-F-PGBRK-C
             TO F-PRNT-C          IN DCLT231RPT.
           MOVE W0001-F-RPTFMT-C
             TO F-RPTFMT-C        IN DCLT231RPT.
           MOVE 'Y'
             TO F-STDRPT-C        IN DCLT231RPT.
           MOVE W0001-F-ELIM-C
             TO F-ELIM-C          IN DCLT231RPT.
           MOVE W0001-F-COLCALC-C
             TO F-COLCALC-C       IN DCLT231RPT.
           MOVE W0001-F-RPT-ORG-C
             TO F-ORG-C           IN DCLT231RPT.
           MOVE W0001-F-RPT-RGN-C
             TO F-RGN-C           IN DCLT231RPT.
           MOVE W0001-F-RPT-LINE-C
             TO F-LN-C            IN DCLT231RPT.
           MOVE W0001-F-RPT-COL-C
             TO F-COL-C           IN DCLT231RPT.
           MOVE W0001-F-RPTID-X01
             TO F-RPTID-X         IN DCLT231RPT.

           EJECT
       D300-BUILD-REC-TYPE-2.

           MOVE 'D300' TO CA-PARAGRAPH-NBR.

           MOVE W0001-F-RPTID-C
             TO F-RPTID-C         IN DCLT231RPT.
           MOVE W0001-RPT-RECTYP-C
             TO DB-RECTYP-C       IN DCLT231RPT.
           MOVE +1
             TO A-SEQ-N           IN DCLT231RPT.
           MOVE W0001-F-RPT-PRNT-C
             TO F-RPTFMT-C        IN DCLT231RPT.
           MOVE W0001-F-RPTLVL01-C
             TO F-PD01-C          IN DCLT231RPT.
           MOVE W0001-F-RPTLVL02-C
             TO F-PD02-C          IN DCLT231RPT.
           MOVE W0001-F-RPTLVL03-C
             TO F-PD03-C          IN DCLT231RPT.
           MOVE W0001-F-RPTLVL04-C
             TO F-PD04-C          IN DCLT231RPT.
           MOVE W0001-F-RPTLVL05-C
             TO F-PD05-C          IN DCLT231RPT.
           MOVE W0001-F-RPTLVL06-C
             TO F-PD06-C          IN DCLT231RPT.
           MOVE W0001-F-RPTLVL07-C
             TO F-PD07-C          IN DCLT231RPT.
           MOVE W0001-F-RPTLVL08-C
             TO F-PD08-C          IN DCLT231RPT.
           MOVE W0001-F-RPTLVL09-C
             TO F-PD09-C          IN DCLT231RPT.
           MOVE W0001-F-RPTLVL10-C
             TO F-PD10-C          IN DCLT231RPT.
           MOVE W0001-F-RPTLVL11-C
             TO F-PD11-C          IN DCLT231RPT.

           EJECT
       D400-BUILD-REC-TYPE-3.

           MOVE 'D400' TO CA-PARAGRAPH-NBR.

           MOVE W0001-F-RPTID-C
             TO F-RPTID-C         IN DCLT231RPT.
           MOVE W0001-RPT-RECTYP-C
             TO DB-RECTYP-C       IN DCLT231RPT.
           MOVE +1
             TO A-SEQ-N           IN DCLT231RPT.
           MOVE W0001-F-RPT-PRNT-C03
             TO F-RPTFMT-C        IN DCLT231RPT.
           MOVE W0001-F-RPTSEQ01-C
             TO F-PD01-C          IN DCLT231RPT.
           MOVE W0001-F-RPTSEQ02-C
             TO F-PD02-C          IN DCLT231RPT.
           MOVE W0001-F-RPTSEQ03-C
             TO F-PD03-C          IN DCLT231RPT.
           MOVE W0001-F-RPTSEQ04-C
             TO F-PD04-C          IN DCLT231RPT.
           MOVE W0001-F-RPTSEQ05-C
             TO F-PD05-C          IN DCLT231RPT.
           MOVE W0001-F-RPTSEQ06-C
             TO F-PD06-C          IN DCLT231RPT.
           MOVE W0001-F-RPTSEQ07-C
             TO F-PD07-C          IN DCLT231RPT.
           MOVE W0001-F-RPTSEQ08-C
             TO F-PD08-C          IN DCLT231RPT.
           MOVE W0001-F-RPTSEQ09-C
             TO F-PD09-C          IN DCLT231RPT.
           MOVE W0001-F-RPTSEQ10-C
             TO F-PD10-C          IN DCLT231RPT.
           MOVE W0001-F-RPTSEQ11-C
             TO F-PD11-C          IN DCLT231RPT.

           EJECT
       D500-BUILD-REC-TYPE-4.

           MOVE 'D500' TO CA-PARAGRAPH-NBR.

           MOVE W0001-F-RPTID-C
             TO F-RPTID-C         IN DCLT231RPT.
           MOVE W0001-RPT-RECTYP-C
             TO DB-RECTYP-C       IN DCLT231RPT.
           MOVE +1
             TO A-SEQ-N           IN DCLT231RPT.

           MOVE W0001-F-DOLLAR-C
             TO F-RPTFMT-C        IN DCLT231RPT.
           MOVE W0001-F-PD01-C
             TO F-PD01-C          IN DCLT231RPT.
           MOVE W0001-F-PD02-C
             TO F-PD02-C          IN DCLT231RPT.
           MOVE W0001-F-PD03-C
             TO F-PD03-C          IN DCLT231RPT.
           MOVE W0001-F-PD04-C
             TO F-PD04-C          IN DCLT231RPT.
           MOVE W0001-F-PD05-C
             TO F-PD05-C          IN DCLT231RPT.
           MOVE W0001-F-PD06-C
             TO F-PD06-C          IN DCLT231RPT.
           MOVE W0001-F-PD07-C
             TO F-PD07-C          IN DCLT231RPT.
           MOVE W0001-F-PD08-C
             TO F-PD08-C          IN DCLT231RPT.
           MOVE W0001-F-PD09-C
             TO F-PD09-C          IN DCLT231RPT.
           MOVE W0001-F-PD10-C
             TO F-PD10-C          IN DCLT231RPT.
           MOVE W0001-F-PD11-C
             TO F-PD11-C          IN DCLT231RPT.
           MOVE W0001-F-PD12-C
             TO F-PD12-C          IN DCLT231RPT.
           MOVE W0001-F-PD13-C
             TO F-PD13-C          IN DCLT231RPT.
           MOVE W0001-F-PD14-C
             TO F-PD14-C          IN DCLT231RPT.

           EJECT
       D600-BUILD-REC-TYPE-5.

           MOVE 'D600' TO CA-PARAGRAPH-NBR.

           MOVE W0001-F-RPTID-C
             TO F-RPTID-C         IN DCLT231RPT.
           MOVE W0001-RPT-RECTYP-C
             TO DB-RECTYP-C       IN DCLT231RPT.
           MOVE +1
             TO A-SEQ-N           IN DCLT231RPT.

           MOVE W0001-F-RPTHDG-C
             TO F-RPTID-X         IN DCLT231RPT.

           EJECT
       D800-INSERT-T231RPT.

           MOVE 'D800' TO CA-PARAGRAPH-NBR.

           EXEC SQL
             INSERT INTO D231.T231RPT
                 ( F_RPTID_C
                 , DB_RECTYP_C
                 , A_SEQ_N
                 , F_PRNT_C
                 , F_RPTFMT_C
                 , F_STDRPT_C
                 , F_ELIM_C
                 , F_COLCALC_C
                 , F_ORG_C
                 , F_RGN_C
                 , F_LN_C
                 , F_COL_C
                 , F_RPTID_X
                 , F_PD01_C
                 , F_PD02_C
                 , F_PD03_C
                 , F_PD04_C
                 , F_PD05_C
                 , F_PD06_C
                 , F_PD07_C
                 , F_PD08_C
                 , F_PD09_C
                 , F_PD10_C
                 , F_PD11_C
                 , F_PD12_C
                 , F_PD13_C
                 , F_PD14_C
                 , DB_UPD_D
                 , DB_UPD_T )
             VALUES
                 ( :DCLT231RPT.F-RPTID-C
                 , :DCLT231RPT.DB-RECTYP-C
                 , :DCLT231RPT.A-SEQ-N
                 , :DCLT231RPT.F-PRNT-C
                 , :DCLT231RPT.F-RPTFMT-C
                 , :DCLT231RPT.F-STDRPT-C
                 , :DCLT231RPT.F-ELIM-C
                 , :DCLT231RPT.F-COLCALC-C
                 , :DCLT231RPT.F-ORG-C
                 , :DCLT231RPT.F-RGN-C
                 , :DCLT231RPT.F-LN-C
                 , :DCLT231RPT.F-COL-C
                 , :DCLT231RPT.F-RPTID-X
                 , :DCLT231RPT.F-PD01-C
                 , :DCLT231RPT.F-PD02-C
                 , :DCLT231RPT.F-PD03-C
                 , :DCLT231RPT.F-PD04-C
                 , :DCLT231RPT.F-PD05-C
                 , :DCLT231RPT.F-PD06-C
                 , :DCLT231RPT.F-PD07-C
                 , :DCLT231RPT.F-PD08-C
                 , :DCLT231RPT.F-PD09-C
                 , :DCLT231RPT.F-PD10-C
                 , :DCLT231RPT.F-PD11-C
                 , :DCLT231RPT.F-PD12-C
                 , :DCLT231RPT.F-PD13-C
                 , :DCLT231RPT.F-PD14-C
                 , CURRENT DATE
                 , CURRENT TIME )
           END-EXEC.

           SET DUP-KEY        TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               ADD +1 TO W0000-OUTPUT-CTR
           END-IF.

           EJECT
       D900-INSERT-T231RPT.

           MOVE 'D900' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                SELECT (MAX(A_SEQ_N) +1)
                  INTO :DCLT231RPT.A-SEQ-N
                  FROM D231.T231RPT
                 WHERE F_RPTID_C     = :DCLT231RPT.F-RPTID-C
                   AND DB_RECTYP_C   = :DCLT231RPT.DB-RECTYP-C
           END-EXEC.

           SET NORMAL-RC-ONLY TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM D800-INSERT-T231RPT.

           EJECT
       E000-PROCESS-T231LINE-RECORD.

           MOVE 'E000' TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231LINE.

           EVALUATE TRUE
               WHEN W0001-T231LINE-COMMENT-REC
                    MOVE W0001-T231LINE
                      TO W0000-PREV-COMMENT (W0000-IX)
                    SET W0000-COMMENT-FOUND TO TRUE
                    ADD +1                  TO W0000-IX
               WHEN W0001-T231LINE-REC-TYPE-1
                    IF  W0000-COMMENT-FOUND
                        PERFORM E100-BUILD-COMMENT-REC
                           VARYING W0000-IX FROM 1 BY 1
                             UNTIL W0000-IX > W0000-LIMIT
                                OR W0000-PREV-COMMENT (W0000-IX)
                                   EQUAL SPACES
                        SET W0000-NO-COMMENT-FOUND TO TRUE
                        MOVE +1                    TO W0000-IX
                        INITIALIZE W0000-COMMENT-TABLE
                    END-IF

                    PERFORM E200-BUILD-REC-TYPE-1
               WHEN W0001-T231LINE-REC-TYPE-2
                    IF  W0000-COMMENT-FOUND
                        PERFORM E100-BUILD-COMMENT-REC
                           VARYING W0000-IX FROM 1 BY 1
                             UNTIL W0000-IX > W0000-LIMIT
                                OR W0000-PREV-COMMENT (W0000-IX)
                                   EQUAL SPACES
                        SET W0000-NO-COMMENT-FOUND TO TRUE
                        MOVE +1                    TO W0000-IX
                        INITIALIZE W0000-COMMENT-TABLE
                    END-IF

                    PERFORM E300-BUILD-REC-TYPE-2

                    IF  W0001-F-LN-N > SPACES
                        MOVE W0001-F-LN-N TO W0000-PREV-LINE
                    END-IF
           END-EVALUATE.

           IF  W0001-T231LINE-COMMENT-REC
               CONTINUE
           ELSE
               PERFORM E400-INSERT-T231LINE

               IF  DB2-DUPLICATE-KEY
                   PERFORM E500-INSERT-T231LINE
               END-IF
           END-IF.

           EJECT
       E100-BUILD-COMMENT-REC 

           MOVE 'E100' TO CA-PARAGRAPH-NBR.

           MOVE W0001-F-LN-C
             TO F-LN-C            IN DCLT231LINE.

           IF  W0001-T231LINE-REC-TYPE-1
               MOVE SPACES
                 TO F-LN-N        IN DCLT231LINE
           ELSE
               MOVE W0001-F-LN-N
                 TO F-LN-N        IN DCLT231LINE
           END-IF.

           MOVE '/'
             TO DB-RECTYP-C       IN DCLT231LINE.
           MOVE +1
             TO A-SEQ-N           IN DCLT231LINE.
           MOVE W0000-PREV-COMMENT-X (W0000-IX)
             TO F-LN-X            IN DCLT231LINE.

           PERFORM E400-INSERT-T231LINE.

           IF  DB2-DUPLICATE-KEY
               PERFORM E500-INSERT-T231LINE
           END-IF.

           INITIALIZE DCLT231LINE.

           EJECT
       E200-BUILD-REC-TYPE-1.

           MOVE 'E200' TO CA-PARAGRAPH-NBR.

           MOVE W0001-F-LN-C
             TO F-LN-C            IN DCLT231LINE.
           MOVE W0001-LINE-RECTYP-C
             TO DB-RECTYP-C       IN DCLT231LINE.
           MOVE +1
             TO A-SEQ-N           IN DCLT231LINE.
           MOVE W0001-F-LINEID-X01
             TO F-LN-X            IN DCLT231LINE.

           EJECT
       E300-BUILD-REC-TYPE-2.

           MOVE 'E300' TO CA-PARAGRAPH-NBR.

           MOVE W0001-F-LN-C
             TO F-LN-C            IN DCLT231LINE.

           IF  W0001-F-LN-N = SPACES
               MOVE W0000-PREV-LINE
                 TO F-LN-N        IN DCLT231LINE
           ELSE
               MOVE W0001-F-LN-N
                 TO F-LN-N        IN DCLT231LINE
           END-IF.

           MOVE +1
             TO A-SEQ-N           IN DCLT231LINE.

           MOVE 'L'
             TO DB-RECTYP-C       IN DCLT231LINE.
           MOVE W0001-F-LN-DESC
             TO F-LN-X            IN DCLT231LINE.
           MOVE W0001-F-FMTTYP-C
             TO F-FMTTYP-C        IN DCLT231LINE.
           MOVE W0001-F-CALC01-CLN
             TO F-CALC01-C        IN DCLT231LINE.
           MOVE W0001-F-CALC02-CLN
             TO F-CALC02-C        IN DCLT231LINE.
           MOVE W0001-F-CALC03-CLN
             TO F-CALC03-C        IN DCLT231LINE.
           MOVE W0001-F-CALC04-CLN
             TO F-CALC04-C        IN DCLT231LINE.
           MOVE W0001-F-CALC05-CLN
             TO F-CALC05-C        IN DCLT231LINE.
           MOVE W0001-F-CALC06-CLN
             TO F-CALC06-C        IN DCLT231LINE.
           MOVE W0001-F-CALC07-CLN
             TO F-CALC07-C        IN DCLT231LINE.
           MOVE W0001-F-CALC08-CLN
             TO F-CALC08-C        IN DCLT231LINE.
           MOVE W0001-F-CALC01-XLN
             TO F-CALC01-X        IN DCLT231LINE.
           MOVE W0001-F-CALC02-XLN
             TO F-CALC02-X        IN DCLT231LINE.
           MOVE W0001-F-CALC03-XLN
             TO F-CALC03-X        IN DCLT231LINE.
           MOVE W0001-F-CALC04-XLN
             TO F-CALC04-X        IN DCLT231LINE.
           MOVE W0001-F-CALC05-XLN
             TO F-CALC05-X        IN DCLT231LINE.
           MOVE W0001-F-CALC06-XLN
             TO F-CALC06-X        IN DCLT231LINE.
           MOVE W0001-F-CALC07-XLN
             TO F-CALC07-X        IN DCLT231LINE.
           MOVE W0001-F-CALC08-XLN
             TO F-CALC08-X        IN DCLT231LINE.

           EJECT
       E400-INSERT-T231LINE.

           MOVE 'E400' TO CA-PARAGRAPH-NBR.

           EXEC SQL
             INSERT INTO D231.T231LINE
                 ( F_LN_C
                 , F_LN_N
                 , A_SEQ_N
                 , DB_RECTYP_C
                 , F_LN_X
                 , F_FMTTYP_C
                 , F_CALC01_C
                 , F_CALC02_C
                 , F_CALC03_C
                 , F_CALC04_C
                 , F_CALC05_C
                 , F_CALC06_C
                 , F_CALC07_C
                 , F_CALC08_C
                 , F_CALC01_X
                 , F_CALC02_X
                 , F_CALC03_X
                 , F_CALC04_X
                 , F_CALC05_X
                 , F_CALC06_X
                 , F_CALC07_X
                 , F_CALC08_X
                 , DB_UPD_D
                 , DB_UPD_T )
             VALUES
                 ( :DCLT231LINE.F-LN-C
                 , :DCLT231LINE.F-LN-N
                 , :DCLT231LINE.A-SEQ-N
                 , :DCLT231LINE.DB-RECTYP-C
                 , :DCLT231LINE.F-LN-X
                 , :DCLT231LINE.F-FMTTYP-C
                 , :DCLT231LINE.F-CALC01-C
                 , :DCLT231LINE.F-CALC02-C
                 , :DCLT231LINE.F-CALC03-C
                 , :DCLT231LINE.F-CALC04-C
                 , :DCLT231LINE.F-CALC05-C
                 , :DCLT231LINE.F-CALC06-C
                 , :DCLT231LINE.F-CALC07-C
                 , :DCLT231LINE.F-CALC08-C
                 , :DCLT231LINE.F-CALC01-X
                 , :DCLT231LINE.F-CALC02-X
                 , :DCLT231LINE.F-CALC03-X
                 , :DCLT231LINE.F-CALC04-X
                 , :DCLT231LINE.F-CALC05-X
                 , :DCLT231LINE.F-CALC06-X
                 , :DCLT231LINE.F-CALC07-X
                 , :DCLT231LINE.F-CALC08-X
                 , CURRENT DATE
                 , CURRENT TIME )
           END-EXEC.

           SET DUP-KEY        TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               ADD +1 TO W0000-OUTPUT-CTR
           END-IF.

           EJECT
       E500-INSERT-T231LINE.

           MOVE 'E500' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                SELECT (MAX(A_SEQ_N) +1)
                  INTO :DCLT231LINE.A-SEQ-N
                  FROM D231.T231LINE
                 WHERE F_LN_C        = :DCLT231LINE.F-LN-C
                   AND F_LN_N        = :DCLT231LINE.F-LN-N
           END-EXEC.

           SET NORMAL-RC-ONLY TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM E400-INSERT-T231LINE.

           EJECT
       F000-PROCESS-T231COL-RECORD.

           MOVE 'F000' TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231COL.

           EVALUATE TRUE
               WHEN W0001-T231COL-COMMENT-REC
                    MOVE W0001-T231COL
                      TO W0000-PREV-COMMENT (W0000-IX)
                    SET W0000-COMMENT-FOUND TO TRUE
                    ADD +1                  TO W0000-IX
               WHEN W0001-T231COL-REC-TYPE-1
                    IF  W0000-COMMENT-FOUND
                        PERFORM F100-BUILD-COMMENT-REC
                           VARYING W0000-IX FROM 1 BY 1
                             UNTIL W0000-IX > W0000-LIMIT
                                OR W0000-PREV-COMMENT (W0000-IX)
                                   EQUAL SPACES
                        SET W0000-NO-COMMENT-FOUND TO TRUE
                        MOVE +1                    TO W0000-IX
                        INITIALIZE W0000-COMMENT-TABLE
                    END-IF

                    PERFORM F200-BUILD-REC-TYPE-1

                    MOVE ZEROES        TO W0000-F-COL-NBR
               WHEN W0001-T231COL-REC-TYPE-2
                    IF  W0000-COMMENT-FOUND
                        MOVE 50        TO W0000-F-COL-NBR
                        PERFORM F100-BUILD-COMMENT-REC
                           VARYING W0000-IX FROM 1 BY 1
                             UNTIL W0000-IX > W0000-LIMIT
                                OR W0000-PREV-COMMENT (W0000-IX)
                                   EQUAL SPACES
                        SET W0000-NO-COMMENT-FOUND TO TRUE
                        MOVE +1                    TO W0000-IX
                        INITIALIZE W0000-COMMENT-TABLE
                    END-IF

                    PERFORM F300-BUILD-REC-TYPE-2
           END-EVALUATE.

           IF  W0001-T231COL-COMMENT-REC
               CONTINUE
           ELSE
               PERFORM F400-INSERT-T231COL
           END-IF.

           EJECT
       F100-BUILD-COMMENT-REC.

           MOVE 'F100' TO CA-PARAGRAPH-NBR.

           MOVE W0001-F-COL-C
             TO F-COL-C           IN DCLT231COL.
           MOVE '/'
             TO DB-RECTYP-C       IN DCLT231COL.
           ADD 1
             TO W0000-F-COL-NBR.
           MOVE W0000-F-COL-N
             TO F-COL-N           IN DCLT231COL.
           MOVE W0000-PREV-COMMENT-X (W0000-IX)
             TO F-COL-X           IN DCLT231COL.

           PERFORM F400-INSERT-T231COL.

           INITIALIZE DCLT231COL.

           EJECT
       F200-BUILD-REC-TYPE-1.

           MOVE 'F200' TO CA-PARAGRAPH-NBR.

           MOVE W0001-F-COL-C
             TO F-COL-C           IN DCLT231COL.
           MOVE '1'
             TO DB-RECTYP-C       IN DCLT231COL.
           MOVE W0001-COL-RECTYP-C
             TO F-COL-N           IN DCLT231COL.
           MOVE W0001-F-COLID-X01
             TO F-COL-X           IN DCLT231COL.

           EJECT
       F300-BUILD-REC-TYPE-2.

           MOVE 'F300' TO CA-PARAGRAPH-NBR.

           MOVE W0001-F-COL-C
             TO F-COL-C           IN DCLT231COL.
           MOVE '2'
             TO DB-RECTYP-C       IN DCLT231COL.
           MOVE W0001-F-COL-N
             TO F-COL-N           IN DCLT231COL.

           MOVE W0001-F-COL-HDG1
             TO F-COLHDG1-X       IN DCLT231COL.
           MOVE W0001-F-COL-HDG2
             TO F-COLHDG2-X       IN DCLT231COL.
           MOVE W0001-F-EDIT-C
             TO F-COLEDIT-C       IN DCLT231COL.

           MOVE W0001-F-CALC01-CCOL
             TO F-CALC01-C        IN DCLT231COL.
           MOVE W0001-F-CALC02-CCOL
             TO F-CALC02-C        IN DCLT231COL.
           MOVE W0001-F-CALC03-CCOL
             TO F-CALC03-C        IN DCLT231COL.
           MOVE W0001-F-CALC04-CCOL
             TO F-CALC04-C        IN DCLT231COL.
           MOVE W0001-F-CALC05-CCOL
             TO F-CALC05-C        IN DCLT231COL.
           MOVE W0001-F-CALC06-CCOL
             TO F-CALC06-C        IN DCLT231COL.
           MOVE W0001-F-CALC07-CCOL
             TO F-CALC07-C        IN DCLT231COL.
           MOVE W0001-F-CALC08-CCOL
             TO F-CALC08-C        IN DCLT231COL.
           MOVE W0001-F-CALC09-CCOL
             TO F-CALC09-C        IN DCLT231COL.
           MOVE W0001-F-CALC10-CCOL
             TO F-CALC10-C        IN DCLT231COL.
           MOVE W0001-F-CALC11-CCOL
             TO F-CALC11-C        IN DCLT231COL.
           MOVE W0001-F-CALC01-XCOL
             TO F-CALC01-X        IN DCLT231COL.
           MOVE W0001-F-CALC02-XCOL
             TO F-CALC02-X        IN DCLT231COL.
           MOVE W0001-F-CALC03-XCOL
             TO F-CALC03-X        IN DCLT231COL.
           MOVE W0001-F-CALC04-XCOL
             TO F-CALC04-X        IN DCLT231COL.
           MOVE W0001-F-CALC05-XCOL
             TO F-CALC05-X        IN DCLT231COL.
           MOVE W0001-F-CALC06-XCOL
             TO F-CALC06-X        IN DCLT231COL.
           MOVE W0001-F-CALC07-XCOL
             TO F-CALC07-X        IN DCLT231COL.
           MOVE W0001-F-CALC08-XCOL
             TO F-CALC08-X        IN DCLT231COL.
           MOVE W0001-F-CALC09-XCOL
             TO F-CALC09-X        IN DCLT231COL.
           MOVE W0001-F-CALC10-XCOL
             TO F-CALC10-X        IN DCLT231COL.
           MOVE W0001-F-CALC11-XCOL
             TO F-CALC11-X        IN DCLT231COL.

           EJECT
       F400-INSERT-T231COL.

           MOVE 'F400' TO CA-PARAGRAPH-NBR.

           EXEC SQL
             INSERT INTO D231.T231COL
                 ( F_COL_C
                 , DB_RECTYP_C
                 , F_COL_N
                 , F_COL_X
                 , F_COLHDG1_X
                 , F_COLHDG2_X
                 , F_COLEDIT_C
                 , F_CALC01_C
                 , F_CALC02_C
                 , F_CALC03_C
                 , F_CALC04_C
                 , F_CALC05_C
                 , F_CALC06_C
                 , F_CALC07_C
                 , F_CALC08_C
                 , F_CALC09_C
                 , F_CALC10_C
                 , F_CALC11_C
                 , F_CALC01_X
                 , F_CALC02_X
                 , F_CALC03_X
                 , F_CALC04_X
                 , F_CALC05_X
                 , F_CALC06_X
                 , F_CALC07_X
                 , F_CALC08_X
                 , F_CALC09_X
                 , F_CALC10_X
                 , F_CALC11_X
                 , DB_UPD_D
                 , DB_UPD_T )
             VALUES
                 ( :DCLT231COL.F-COL-C
                 , :DCLT231COL.DB-RECTYP-C
                 , :DCLT231COL.F-COL-N
                 , :DCLT231COL.F-COL-X
                 , :DCLT231COL.F-COLHDG1-X
                 , :DCLT231COL.F-COLHDG2-X
                 , :DCLT231COL.F-COLEDIT-C
                 , :DCLT231COL.F-CALC01-C
                 , :DCLT231COL.F-CALC02-C
                 , :DCLT231COL.F-CALC03-C
                 , :DCLT231COL.F-CALC04-C
                 , :DCLT231COL.F-CALC05-C
                 , :DCLT231COL.F-CALC06-C
                 , :DCLT231COL.F-CALC07-C
                 , :DCLT231COL.F-CALC08-C
                 , :DCLT231COL.F-CALC09-C
                 , :DCLT231COL.F-CALC10-C
                 , :DCLT231COL.F-CALC11-C
                 , :DCLT231COL.F-CALC01-X
                 , :DCLT231COL.F-CALC02-X
                 , :DCLT231COL.F-CALC03-X
                 , :DCLT231COL.F-CALC04-X
                 , :DCLT231COL.F-CALC05-X
                 , :DCLT231COL.F-CALC06-X
                 , :DCLT231COL.F-CALC07-X
                 , :DCLT231COL.F-CALC08-X
                 , :DCLT231COL.F-CALC09-X
                 , :DCLT231COL.F-CALC10-X
                 , :DCLT231COL.F-CALC11-X
                 , CURRENT DATE
                 , CURRENT TIME )
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               ADD +1 TO W0000-OUTPUT-CTR
           END-IF.

           EJECT
       G000-PROCESS-T231PRIM-RECORD.

           MOVE 'G000' TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231PRIM.

           EVALUATE TRUE
               WHEN W0001-T231PRIM-COMMENT-REC
                    MOVE W0001-T231PRIM
                      TO W0000-PREV-COMMENT (W0000-IX)
                    SET W0000-COMMENT-FOUND TO TRUE
                    ADD +1                  TO W0000-IX
               WHEN OTHER
                    IF  W0000-COMMENT-FOUND
                        PERFORM G100-BUILD-COMMENT-REC
                           VARYING W0000-IX FROM 1 BY 1
                             UNTIL W0000-IX > W0000-LIMIT
                               OR W0000-PREV-COMMENT (W0000-IX)
                                  EQUAL SPACES
                        SET W0000-NO-COMMENT-FOUND TO TRUE
                        MOVE +1                    TO W0000-IX
                        INITIALIZE W0000-COMMENT-TABLE
                    END-IF

                    PERFORM G200-BUILD-REC-TYPE-1
                    PERFORM G400-INSERT-T231PRIM

                    IF  DB2-DUPLICATE-KEY
                        PERFORM G500-INSERT-T231PRIM
                    END-IF

                    IF  W0001-F-PRMACCT-C > SPACES
      *BWM*             IF  W0001-F-PRMACCT-C NOT EQUAL
      *BWM*                 W0000-PREV-PRIME
      *BWM*                 MOVE ZEROES         TO W0000-SEQ-NBR
      *BWM*             END-IF
                        MOVE W0001-F-PRMACCT-C TO W0000-PREV-PRIME
                    END-IF
           END-EVALUATE.

           EJECT
       G100-BUILD-COMMENT-REC.

           MOVE 'G100' TO CA-PARAGRAPH-NBR.

           MOVE W0000-PREV-PRIME
             TO F-PRMACCT-C       IN DCLT231PRIM.
           MOVE '/'
             TO DB-RECTYP-C       IN DCLT231PRIM.
      *BWM*MOVE +1
           ADD +1                 TO W0000-SEQ-NBR
           MOVE W0000-SEQ-NBR
             TO A-SEQ-N           IN DCLT231PRIM.
           MOVE W0000-PREV-COMMENT-X (W0000-IX)
             TO F-PRMACCT-X       IN DCLT231PRIM.

           PERFORM G400-INSERT-T231PRIM.

           IF  DB2-DUPLICATE-KEY
               PERFORM G500-INSERT-T231PRIM
           END-IF.

           INITIALIZE DCLT231PRIM.

           EJECT
       G200-BUILD-REC-TYPE-1.

           MOVE 'G200' TO CA-PARAGRAPH-NBR.

           IF  W0001-F-PRMACCT-C = SPACES
               MOVE W0000-PREV-PRIME
                 TO F-PRMACCT-C       IN DCLT231PRIM
           ELSE
               MOVE W0001-F-PRMACCT-C
                 TO F-PRMACCT-C       IN DCLT231PRIM
           END-IF.

           MOVE '1'
             TO DB-RECTYP-C       IN DCLT231PRIM.

      *BWM*MOVE +1
           ADD +1                 TO W0000-SEQ-NBR
           MOVE W0000-SEQ-NBR
             TO A-SEQ-N           IN DCLT231PRIM.

           MOVE W0001-F-FCSLN-N
             TO F-FCSLN-N         IN DCLT231PRIM.
           MOVE W0001-F-BALSHT-C
             TO F-BALSHT-C        IN DCLT231PRIM.
           MOVE W0001-F-DIVSUM-C
             TO F-DIVID-C         IN DCLT231PRIM.
           MOVE W0001-F-PRMACCT-X
             TO F-PRMACCT-X       IN DCLT231PRIM.

           IF  W0001-F-SUBACCT-1  NOT EQUAL SPACES
           AND W0001-F-SUBACCT-2  NOT EQUAL SPACES
           AND W0001-F-SUBACCT-3  NOT EQUAL SPACES
           AND W0001-F-SUBACCT-4  NOT EQUAL SPACES
           AND W0001-F-SUBACCT-5  NOT EQUAL SPACES
           AND W0001-F-SUBACCT-6  NOT EQUAL SPACES
           AND W0001-F-SUBACCT-7  NOT EQUAL SPACES
           AND W0001-F-SUBACCT-X      EQUAL SPACES
               MOVE W0001-F-PRMSUBACCT-C
                 TO F-PRMSUBACCT-C    IN DCLT231PRIM
           ELSE
               MOVE W0001-F-CALC01-CPRIM
                 TO F-CALC01-C        IN DCLT231PRIM
               MOVE W0001-F-CALC02-CPRIM
                 TO F-CALC02-C        IN DCLT231PRIM
               MOVE W0001-F-CALC03-CPRIM
                 TO F-CALC03-C        IN DCLT231PRIM
               MOVE W0001-F-CALC04-CPRIM
                 TO F-CALC04-C        IN DCLT231PRIM
               MOVE W0001-F-CALC05-CPRIM
                 TO F-CALC05-C        IN DCLT231PRIM
               MOVE W0001-F-CALC06-CPRIM
                 TO F-CALC06-C        IN DCLT231PRIM
               MOVE W0001-F-CALC07-CPRIM
                 TO F-CALC07-C        IN DCLT231PRIM
               MOVE W0001-F-CALC08-CPRIM
                 TO F-CALC08-C        IN DCLT231PRIM
               MOVE W0001-F-CALC01-XPRIM
                 TO F-CALC01-X        IN DCLT231PRIM
               MOVE W0001-F-CALC02-XPRIM
                 TO F-CALC02-X        IN DCLT231PRIM
               MOVE W0001-F-CALC03-XPRIM
                 TO F-CALC03-X        IN DCLT231PRIM
               MOVE W0001-F-CALC04-XPRIM
                 TO F-CALC04-X        IN DCLT231PRIM
               MOVE W0001-F-CALC05-XPRIM
                 TO F-CALC05-X        IN DCLT231PRIM
               MOVE W0001-F-CALC06-XPRIM
                 TO F-CALC06-X        IN DCLT231PRIM
               MOVE W0001-F-CALC07-XPRIM
                 TO F-CALC07-X        IN DCLT231PRIM
               MOVE W0001-F-CALC08-XPRIM
                 TO F-CALC08-X        IN DCLT231PRIM
           END-IF.

           EJECT
       G400-INSERT-T231PRIM.

           MOVE 'G400' TO CA-PARAGRAPH-NBR.

           EXEC SQL
             INSERT INTO D231.T231PRIM
                 ( F_PRMACCT_C
                 , DB_RECTYP_C
                 , A_SEQ_N
                 , F_FCSLN_N
                 , F_BALSHT_C
                 , F_DIVID_C
                 , F_PRMACCT_X
                 , F_PRMSUBACCT_C
                 , F_CALC01_C
                 , F_CALC02_C
                 , F_CALC03_C
                 , F_CALC04_C
                 , F_CALC05_C
                 , F_CALC06_C
                 , F_CALC07_C
                 , F_CALC08_C
                 , F_CALC01_X
                 , F_CALC02_X
                 , F_CALC03_X
                 , F_CALC04_X
                 , F_CALC05_X
                 , F_CALC06_X
                 , F_CALC07_X
                 , F_CALC08_X
                 , DB_UPD_D
                 , DB_UPD_T )
             VALUES
                 ( :DCLT231PRIM.F-PRMACCT-C
                 , :DCLT231PRIM.DB-RECTYP-C
                 , :DCLT231PRIM.A-SEQ-N
                 , :DCLT231PRIM.F-FCSLN-N
                 , :DCLT231PRIM.F-BALSHT-C
                 , :DCLT231PRIM.F-DIVID-C
                 , :DCLT231PRIM.F-PRMACCT-X
                 , :DCLT231PRIM.F-PRMSUBACCT-C
                 , :DCLT231PRIM.F-CALC01-C
                 , :DCLT231PRIM.F-CALC02-C
                 , :DCLT231PRIM.F-CALC03-C
                 , :DCLT231PRIM.F-CALC04-C
                 , :DCLT231PRIM.F-CALC05-C
                 , :DCLT231PRIM.F-CALC06-C
                 , :DCLT231PRIM.F-CALC07-C
                 , :DCLT231PRIM.F-CALC08-C
                 , :DCLT231PRIM.F-CALC01-X
                 , :DCLT231PRIM.F-CALC02-X
                 , :DCLT231PRIM.F-CALC03-X
                 , :DCLT231PRIM.F-CALC04-X
                 , :DCLT231PRIM.F-CALC05-X
                 , :DCLT231PRIM.F-CALC06-X
                 , :DCLT231PRIM.F-CALC07-X
                 , :DCLT231PRIM.F-CALC08-X
                 , CURRENT DATE
                 , CURRENT TIME )
           END-EXEC.

           SET DUP-KEY        TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               ADD +1 TO W0000-OUTPUT-CTR
           END-IF.

           EJECT
       G500-INSERT-T231PRIM.

           MOVE 'G500' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                SELECT (MAX(A_SEQ_N) +1)
                  INTO :DCLT231PRIM.A-SEQ-N
                  FROM D231.T231PRIM
                 WHERE F_PRMACCT_C   = :DCLT231PRIM.F-PRMACCT-C
                   AND DB_RECTYP_C   = :DCLT231PRIM.DB-RECTYP-C
           END-EXEC.

           SET NORMAL-RC-ONLY TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM G400-INSERT-T231PRIM.

           EJECT
       H000-PROCESS-T231ORG-RECORD.

           MOVE 'H000' TO CA-PARAGRAPH-NBR.

      *BWM*
      *BWM*INITIALIZE DCLT231ORG.
      *BWM*
      *BWM*EVALUATE TRUE
      *BWM*    WHEN W0001-T231ORG-COMMENT-REC
      *BWM*         MOVE W0001-T231ORG
      *BWM*           TO W0000-PREV-COMMENT (W0000-IX)
      *BWM*         SET W0000-COMMENT-FOUND TO TRUE
      *BWM*         ADD +1                  TO W0000-IX
      *BWM*    WHEN W0001-T231ORG-REC-TYPE-2
      *BWM*         IF  W0000-COMMENT-FOUND
      *BWM*             PERFORM H100-BUILD-COMMENT-REC
      *BWM*                VARYING W0000-IX FROM 1 BY 1
      *BWM*                  UNTIL W0000-IX > W0000-LIMIT
      *BWM*                     OR W0000-PREV-COMMENT (W0000-IX)
      *BWM*                        EQUAL SPACES
      *BWM*             SET W0000-NO-COMMENT-FOUND TO TRUE
      *BWM*             MOVE +1                    TO W0000-IX
      *BWM*             INITIALIZE W0000-COMMENT-TABLE
      *BWM*         END-IF
      *BWM*
      *BWM*         PERFORM H300-BUILD-REC-TYPE-2
      *BWM*    WHEN OTHER
      *BWM*         IF  W0000-COMMENT-FOUND
      *BWM*             PERFORM H100-BUILD-COMMENT-REC
      *BWM*                VARYING W0000-IX FROM 1 BY 1
      *BWM*                  UNTIL W0000-IX > W0000-LIMIT
      *BWM*                     OR W0000-PREV-COMMENT (W0000-IX)
      *BWM*                        EQUAL SPACES
      *BWM*             SET W0000-NO-COMMENT-FOUND TO TRUE
      *BWM*             MOVE +1                    TO W0000-IX
      *BWM*             INITIALIZE W0000-COMMENT-TABLE
      *BWM*         END-IF
      *BWM*
      *BWM*         PERFORM H200-BUILD-REC-TYPE-1
      *BWM*END-EVALUATE.
      *BWM*
      *BWM*IF  W0001-T231ORG-COMMENT-REC
      *BWM*    CONTINUE
      *BWM*ELSE
      *BWM*    PERFORM H400-INSERT-T231ORG
      *BWM*
      *BWM*    IF  DB2-DUPLICATE-KEY
      *BWM*        PERFORM H500-INSERT-T231ORG
      *BWM*    END-IF
      *BWM*END-IF.
      *BWM*
      *BWM*EJECT
      *H100-BUILD-COMMENT-REC.
      *BWM*
      *BWM*MOVE 'H100' TO CA-PARAGRAPH-NBR.
      *BWM*
      *BWM*MOVE W0001-F-ORG-C
      *BWM*  TO F-ORG-C           IN DCLT231ORG.
      *BWM*
      *BWM*IF  W0001-T231ORG-REC-TYPE-2
      *BWM*    MOVE '2'
      *BWM*      TO DB-RECTYP-C   IN DCLT231ORG
      *BWM*ELSE
      *BWM*    MOVE '1'
      *BWM*      TO DB-RECTYP-C   IN DCLT231ORG
      *BWM*END-IF
      *BWM*
      *BWM*MOVE '/'
      *BWM*  TO F-CMNT-I          IN DCLT231ORG.
      *BWM*
      *BWM*MOVE W0001-F-ORGLVL01-C
      *BWM*  TO F-ORGLVL01-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGLVL02-C
      *BWM*  TO F-ORGLVL02-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGLVL03-C
      *BWM*  TO F-ORGLVL03-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGLVL04-C
      *BWM*  TO F-ORGLVL04-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGLVL05-C
      *BWM*  TO F-ORGLVL05-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGLVL06-C
      *BWM*  TO F-ORGLVL06-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGLVL07-C
      *BWM*  TO F-ORGLVL07-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGLVL08-C
      *BWM*  TO F-ORGLVL08-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGLVL09-C
      *BWM*  TO F-ORGLVL09-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGLVL10-C
      *BWM*  TO F-ORGLVL10-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGLVL11-C
      *BWM*  TO F-ORGLVL11-C      IN DCLT231ORG.
      *BWM*MOVE +1
      *BWM*  TO A-SEQ-N           IN DCLT231ORG.
      *BWM*
      *BWM*MOVE W0000-PREV-COMMENT-X (W0000-IX)
      *BWM*  TO F-ORG-X           IN DCLT231ORG.
      *BWM*
      *BWM*PERFORM H400-INSERT-T231ORG.
      *BWM*
      *BWM*IF  DB2-DUPLICATE-KEY
      *BWM*    PERFORM H500-INSERT-T231ORG
      *BWM*END-IF.
      *BWM*
      *BWM*INITIALIZE DCLT231ORG.
      *BWM*
      *BWM*EJECT
      *H200-BUILD-REC-TYPE-1.
      *BWM*
      *BWM*MOVE 'H200' TO CA-PARAGRAPH-NBR.
      *BWM*
      *BWM*MOVE W0001-F-ORG-C
      *BWM*  TO F-ORG-C           IN DCLT231ORG.
      *BWM*MOVE '1'
      *BWM*  TO DB-RECTYP-C       IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGLVL01-C
      *BWM*  TO F-ORGLVL01-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGLVL02-C
      *BWM*  TO F-ORGLVL02-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGLVL03-C
      *BWM*  TO F-ORGLVL03-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGLVL04-C
      *BWM*  TO F-ORGLVL04-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGLVL05-C
      *BWM*  TO F-ORGLVL05-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGLVL06-C
      *BWM*  TO F-ORGLVL06-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGLVL07-C
      *BWM*  TO F-ORGLVL07-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGLVL08-C
      *BWM*  TO F-ORGLVL08-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGLVL09-C
      *BWM*  TO F-ORGLVL09-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGLVL10-C
      *BWM*  TO F-ORGLVL10-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGLVL11-C
      *BWM*  TO F-ORGLVL11-C      IN DCLT231ORG.
      *BWM*MOVE +1
      *BWM*  TO A-SEQ-N           IN DCLT231ORG.
      *BWM*
      *BWM*MOVE W0001-F-DFLTAFM-C
      *BWM*  TO F-DFLTAFM-C       IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORG-X
      *BWM*  TO F-ORG-X           IN DCLT231ORG.
      *BWM*
      *BWM*EJECT
      *H300-BUILD-REC-TYPE-2.
      *BWM*
      *BWM*MOVE 'H300' TO CA-PARAGRAPH-NBR.
      *BWM*
      *BWM*MOVE W0001-F-ORG-C
      *BWM*  TO F-ORG-C           IN DCLT231ORG.
      *BWM*MOVE '2'
      *BWM*  TO DB-RECTYP-C       IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGROLLUP01-C
      *BWM*  TO F-ORGLVL01-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGROLLUP02-C
      *BWM*  TO F-ORGLVL02-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGROLLUP03-C
      *BWM*  TO F-ORGLVL03-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGROLLUP04-C
      *BWM*  TO F-ORGLVL04-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGROLLUP05-C
      *BWM*  TO F-ORGLVL05-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGROLLUP06-C
      *BWM*  TO F-ORGLVL06-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGROLLUP07-C
      *BWM*  TO F-ORGLVL07-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGROLLUP08-C
      *BWM*  TO F-ORGLVL08-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGROLLUP09-C
      *BWM*  TO F-ORGLVL09-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGROLLUP10-C
      *BWM*  TO F-ORGLVL10-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGROLLUP11-C
      *BWM*  TO F-ORGLVL11-C      IN DCLT231ORG.
      *BWM*MOVE +1
      *BWM*  TO A-SEQ-N           IN DCLT231ORG.
      *BWM*
      *BWM*MOVE W0001-F-ORGID-C
      *BWM*  TO F-ORGID-C         IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGPRNT-C
      *BWM*  TO F-PRNT-C          IN DCLT231ORG.
      *BWM*MOVE W0001-F-DIVAFM01-C
      *BWM*  TO F-DIVAFM01-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-DIVAFM02-C
      *BWM*  TO F-DIVAFM02-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-DIVAFM03-C
      *BWM*  TO F-DIVAFM03-C      IN DCLT231ORG.
      *BWM*MOVE W0001-F-ORGLN-X
      *BWM*  TO F-ORG-X           IN DCLT231ORG.
      *BWM*
      *BWM*EJECT
      *H400-INSERT-T231ORG.
      *BWM*
      *BWM*MOVE 'H400' TO CA-PARAGRAPH-NBR.
      *BWM*
      *BWM*EXEC SQL
      *BWM*  INSERT INTO D231.T231ORG
      *BWM*      ( F_ORG_C
      *BWM*      , DB_RECTYP_C
      *BWM*      , F_ORGLVL01_C
      *BWM*      , F_ORGLVL02_C
      *BWM*      , F_ORGLVL03_C
      *BWM*      , F_ORGLVL04_C
      *BWM*      , F_ORGLVL05_C
      *BWM*      , F_ORGLVL06_C
      *BWM*      , F_ORGLVL07_C
      *BWM*      , F_ORGLVL08_C
      *BWM*      , F_ORGLVL09_C
      *BWM*      , F_ORGLVL10_C
      *BWM*      , F_ORGLVL11_C
      *BWM*      , A_SEQ_N
      *BWM*      , F_CMNT_I
      *BWM*      , F_DFLTAFM_C
      *BWM*      , F_ORGID_C
      *BWM*      , F_PRNT_C
      *BWM*      , F_DIVAFM01_C
      *BWM*      , F_DIVAFM02_C
      *BWM*      , F_DIVAFM03_C
      *BWM*      , F_ORG_X
      *BWM*      , DB_UPD_D
      *BWM*      , DB_UPD_T )
      *BWM*  VALUES
      *BWM*      ( :DCLT231ORG.F-ORG-C
      *BWM*      , :DCLT231ORG.DB-RECTYP-C
      *BWM*      , :DCLT231ORG.F-ORGLVL01-C
      *BWM*      , :DCLT231ORG.F-ORGLVL02-C
      *BWM*      , :DCLT231ORG.F-ORGLVL03-C
      *BWM*      , :DCLT231ORG.F-ORGLVL04-C
      *BWM*      , :DCLT231ORG.F-ORGLVL05-C
      *BWM*      , :DCLT231ORG.F-ORGLVL06-C
      *BWM*      , :DCLT231ORG.F-ORGLVL07-C
      *BWM*      , :DCLT231ORG.F-ORGLVL08-C
      *BWM*      , :DCLT231ORG.F-ORGLVL09-C
      *BWM*      , :DCLT231ORG.F-ORGLVL10-C
      *BWM*      , :DCLT231ORG.F-ORGLVL11-C
      *BWM*      , :DCLT231ORG.A-SEQ-N
      *BWM*      , :DCLT231ORG.F-CMNT-I
      *BWM*      , :DCLT231ORG.F-DFLTAFM-C
      *BWM*      , :DCLT231ORG.F-ORGID-C
      *BWM*      , :DCLT231ORG.F-PRNT-C
      *BWM*      , :DCLT231ORG.F-DIVAFM01-C
      *BWM*      , :DCLT231ORG.F-DIVAFM02-C
      *BWM*      , :DCLT231ORG.F-DIVAFM03-C
      *BWM*      , :DCLT231ORG.F-ORG-X
      *BWM*      , CURRENT DATE
      *BWM*      , CURRENT TIME )
      *BWM*END-EXEC.
      *BWM*
      *BWM*SET DUP-KEY        TO TRUE.
      *BWM*PERFORM Z900-DB2-CHECK.
      *BWM*
      *BWM*IF  DB2-NORMAL
      *BWM*    ADD +1 TO W0000-OUTPUT-CTR
      *BWM*END-IF.
      *BWM*
      *BWM*EJECT
      *H500-INSERT-T231ORG.
      *BWM*
      *BWM*MOVE 'H500' TO CA-PARAGRAPH-NBR.
      *BWM*
      *BWM*EXEC SQL
      *BWM*     SELECT (MAX(A_SEQ_N) +1)
      *BWM*       INTO :DCLT231ORG.A-SEQ-N
      *BWM*       FROM D231.T231ORG
      *BWM*      WHERE F_ORG_C       = :DCLT231ORG.F-ORG-C
      *BWM*        AND DB_RECTYP_C   = :DCLT231ORG.DB-RECTYP-C
      *BWM*        AND F_ORGLVL01_C  = :DCLT231ORG.F-ORGLVL01-C
      *BWM*        AND F_ORGLVL02_C  = :DCLT231ORG.F-ORGLVL02-C
      *BWM*        AND F_ORGLVL03_C  = :DCLT231ORG.F-ORGLVL03-C
      *BWM*        AND F_ORGLVL04_C  = :DCLT231ORG.F-ORGLVL04-C
      *BWM*        AND F_ORGLVL05_C  = :DCLT231ORG.F-ORGLVL05-C
      *BWM*        AND F_ORGLVL06_C  = :DCLT231ORG.F-ORGLVL06-C
      *BWM*        AND F_ORGLVL07_C  = :DCLT231ORG.F-ORGLVL07-C
      *BWM*        AND F_ORGLVL08_C  = :DCLT231ORG.F-ORGLVL08-C
      *BWM*        AND F_ORGLVL09_C  = :DCLT231ORG.F-ORGLVL09-C
      *BWM*        AND F_ORGLVL10_C  = :DCLT231ORG.F-ORGLVL10-C
      *BWM*        AND F_ORGLVL11_C  = :DCLT231ORG.F-ORGLVL11-C
      *BWM*END-EXEC.
      *BWM*
      *BWM*SET NORMAL-RC-ONLY TO TRUE.
      *BWM*PERFORM Z900-DB2-CHECK.
      *BWM*
      *BWM*PERFORM H400-INSERT-T231ORG.

           EJECT
       I000-PROCESS-T231RGN-RECORD.

           MOVE 'I000' TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231RGN.

           EVALUATE TRUE
               WHEN W0001-T231RGN-COMMENT-REC
                    MOVE W0001-T231RGN
                      TO W0000-PREV-COMMENT (W0000-IX)
                    SET W0000-COMMENT-FOUND TO TRUE
                    ADD +1                  TO W0000-IX
               WHEN W0001-T231RGN-REC-TYPE-2
                    IF  W0000-COMMENT-FOUND
                        PERFORM I100-BUILD-COMMENT-REC
                           VARYING W0000-IX FROM 1 BY 1
                             UNTIL W0000-IX > W0000-LIMIT
                                OR W0000-PREV-COMMENT (W0000-IX)
                                   EQUAL SPACES
                        SET W0000-NO-COMMENT-FOUND TO TRUE
                        MOVE +1                    TO W0000-IX
                        INITIALIZE W0000-COMMENT-TABLE
                    END-IF

                    PERFORM I300-BUILD-REC-TYPE-2
               WHEN OTHER
                    IF  W0000-COMMENT-FOUND
                        PERFORM I100-BUILD-COMMENT-REC
                           VARYING W0000-IX FROM 1 BY 1
                             UNTIL W0000-IX > W0000-LIMIT
                                OR W0000-PREV-COMMENT (W0000-IX)
                                   EQUAL SPACES
                        SET W0000-NO-COMMENT-FOUND TO TRUE
                        MOVE +1                    TO W0000-IX
                        INITIALIZE W0000-COMMENT-TABLE
                    END-IF

                    PERFORM I200-BUILD-REC-TYPE-1
           END-EVALUATE.

           IF  W0001-T231RGN-COMMENT-REC
               CONTINUE
           ELSE
               PERFORM I400-INSERT-T231RGN

               IF  DB2-DUPLICATE-KEY
                   PERFORM I500-INSERT-T231RGN
               END-IF
           END-IF.

           EJECT
       I100-BUILD-COMMENT-REC.

           MOVE 'I100' TO CA-PARAGRAPH-NBR.

           MOVE W0001-F-RGN-C
             TO F-RGN-C           IN DCLT231RGN.

           IF  W0001-T231RGN-REC-TYPE-2
               MOVE '2'
                 TO DB-RECTYP-C   IN DCLT231RGN
           ELSE
               MOVE '1'
                 TO DB-RECTYP-C   IN DCLT231RGN
           END-IF

           MOVE '/'
             TO F-CMNT-I          IN DCLT231RGN.

           MOVE W0001-F-RGNLVL01-C
             TO F-ORGLVL01-C      IN DCLT231RGN.
           MOVE W0001-F-RGNLVL02-C
             TO F-ORGLVL02-C      IN DCLT231RGN.
           MOVE W0001-F-RGNLVL03-C
             TO F-ORGLVL03-C      IN DCLT231RGN.
           MOVE W0001-F-RGNLVL04-C
             TO F-ORGLVL04-C      IN DCLT231RGN.
           MOVE W0001-F-RGNLVL05-C
             TO F-ORGLVL05-C      IN DCLT231RGN.
           MOVE W0001-F-RGNLVL06-C
             TO F-ORGLVL06-C      IN DCLT231RGN.
           MOVE W0001-F-RGNLVL07-C
             TO F-ORGLVL07-C      IN DCLT231RGN.
           MOVE W0001-F-RGNLVL08-C
             TO F-ORGLVL08-C      IN DCLT231RGN.
           MOVE +1
             TO A-SEQ-N           IN DCLT231RGN.

           MOVE W0000-PREV-COMMENT-X (W0000-IX)
             TO F-RGN-X           IN DCLT231RGN.

           PERFORM I400-INSERT-T231RGN.

           IF  DB2-DUPLICATE-KEY
               PERFORM I500-INSERT-T231RGN
           END-IF.

           INITIALIZE DCLT231RGN.

           EJECT
       I200-BUILD-REC-TYPE-1.

           MOVE 'I200' TO CA-PARAGRAPH-NBR.

           MOVE W0001-F-RGN-C
             TO F-RGN-C           IN DCLT231RGN.
           MOVE '1'
             TO DB-RECTYP-C       IN DCLT231RGN.
           MOVE W0001-F-RGNLVL01-C
             TO F-ORGLVL01-C      IN DCLT231RGN.
           MOVE W0001-F-RGNLVL02-C
             TO F-ORGLVL02-C      IN DCLT231RGN.
           MOVE W0001-F-RGNLVL03-C
             TO F-ORGLVL03-C      IN DCLT231RGN.
           MOVE W0001-F-RGNLVL04-C
             TO F-ORGLVL04-C      IN DCLT231RGN.
           MOVE W0001-F-RGNLVL05-C
             TO F-ORGLVL05-C      IN DCLT231RGN.
           MOVE W0001-F-RGNLVL06-C
             TO F-ORGLVL06-C      IN DCLT231RGN.
           MOVE W0001-F-RGNLVL07-C
             TO F-ORGLVL07-C      IN DCLT231RGN.
           MOVE W0001-F-RGNLVL08-C
             TO F-ORGLVL08-C      IN DCLT231RGN.
           MOVE +1
             TO A-SEQ-N           IN DCLT231RGN.

           MOVE W0001-F-RGN-X
             TO F-RGN-X           IN DCLT231RGN.


           EJECT
       I300-BUILD-REC-TYPE-2.

           MOVE 'I300' TO CA-PARAGRAPH-NBR.

           MOVE W0001-F-RGN-C
             TO F-RGN-C           IN DCLT231RGN.
           MOVE '2'
             TO DB-RECTYP-C       IN DCLT231RGN.
           MOVE W0001-F-RGNROLLUP01-C
             TO F-ORGLVL01-C      IN DCLT231RGN.
           MOVE W0001-F-RGNROLLUP02-C
             TO F-ORGLVL02-C      IN DCLT231RGN.
           MOVE W0001-F-RGNROLLUP03-C
             TO F-ORGLVL03-C      IN DCLT231RGN.
           MOVE W0001-F-RGNROLLUP04-C
             TO F-ORGLVL04-C      IN DCLT231RGN.
           MOVE W0001-F-RGNROLLUP05-C
             TO F-ORGLVL05-C      IN DCLT231RGN.
           MOVE W0001-F-RGNROLLUP06-C
             TO F-ORGLVL06-C      IN DCLT231RGN.
           MOVE W0001-F-RGNROLLUP07-C
             TO F-ORGLVL07-C      IN DCLT231RGN.
           MOVE W0001-F-RGNROLLUP08-C
             TO F-ORGLVL08-C      IN DCLT231RGN.
           MOVE +1
             TO A-SEQ-N           IN DCLT231RGN.

           MOVE W0001-F-RGNID-C
             TO F-RGNID-C         IN DCLT231RGN.
           MOVE W0001-F-RGNLOC-C
             TO F-LOC-C           IN DCLT231RGN.
           MOVE W0001-F-RGNDIV-C
             TO F-DIV-C           IN DCLT231RGN.
           MOVE W0001-F-RGNAFM-C
             TO F-AFM-C           IN DCLT231RGN.
           MOVE W0001-F-RGNLN-X
             TO F-RGN-X           IN DCLT231RGN.

           EJECT
       I400-INSERT-T231RGN.

           MOVE 'I400' TO CA-PARAGRAPH-NBR.

           EXEC SQL
             INSERT INTO D231.T231RGN
                 ( F_RGN_C
                 , DB_RECTYP_C
                 , F_ORGLVL01_C
                 , F_ORGLVL02_C
                 , F_ORGLVL03_C
                 , F_ORGLVL04_C
                 , F_ORGLVL05_C
                 , F_ORGLVL06_C
                 , F_ORGLVL07_C
                 , F_ORGLVL08_C
                 , A_SEQ_N
                 , F_CMNT_I
                 , F_RGNID_C
                 , F_LOC_C
                 , F_DIV_C
                 , F_AFM_C
                 , F_RGN_X
                 , DB_UPD_D
                 , DB_UPD_T )
             VALUES
                 ( :DCLT231RGN.F-RGN-C
                 , :DCLT231RGN.DB-RECTYP-C
                 , :DCLT231RGN.F-ORGLVL01-C
                 , :DCLT231RGN.F-ORGLVL02-C
                 , :DCLT231RGN.F-ORGLVL03-C
                 , :DCLT231RGN.F-ORGLVL04-C
                 , :DCLT231RGN.F-ORGLVL05-C
                 , :DCLT231RGN.F-ORGLVL06-C
                 , :DCLT231RGN.F-ORGLVL07-C
                 , :DCLT231RGN.F-ORGLVL08-C
                 , :DCLT231RGN.A-SEQ-N
                 , :DCLT231RGN.F-CMNT-I
                 , :DCLT231RGN.F-RGNID-C
                 , :DCLT231RGN.F-LOC-C
                 , :DCLT231RGN.F-DIV-C
                 , :DCLT231RGN.F-AFM-C
                 , :DCLT231RGN.F-RGN-X
                 , CURRENT DATE
                 , CURRENT TIME )
           END-EXEC.

           SET DUP-KEY        TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               ADD +1 TO W0000-OUTPUT-CTR
           END-IF.

           EJECT
       I500-INSERT-T231RGN.

           MOVE 'I500' TO CA-PARAGRAPH-NBR.

           EXEC SQL
                SELECT (MAX(A_SEQ_N) +1)
                  INTO :DCLT231RGN.A-SEQ-N
                  FROM D231.T231RGN
                 WHERE F_RGN_C       = :DCLT231RGN.F-RGN-C
                   AND DB_RECTYP_C   = :DCLT231RGN.DB-RECTYP-C
                   AND F_ORGLVL01_C  = :DCLT231RGN.F-ORGLVL01-C
                   AND F_ORGLVL02_C  = :DCLT231RGN.F-ORGLVL02-C
                   AND F_ORGLVL03_C  = :DCLT231RGN.F-ORGLVL03-C
                   AND F_ORGLVL04_C  = :DCLT231RGN.F-ORGLVL04-C
                   AND F_ORGLVL05_C  = :DCLT231RGN.F-ORGLVL05-C
                   AND F_ORGLVL06_C  = :DCLT231RGN.F-ORGLVL06-C
                   AND F_ORGLVL07_C  = :DCLT231RGN.F-ORGLVL07-C
                   AND F_ORGLVL08_C  = :DCLT231RGN.F-ORGLVL08-C
           END-EXEC.

           SET NORMAL-RC-ONLY TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM I400-INSERT-T231RGN.

           EJECT
       J000-PROCESS-T231MNEM-RECORD.

           MOVE 'J000' TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231MNEM.

           EVALUATE TRUE
               WHEN W0001-T231MNEM-REC-TYPE-1
                    PERFORM J100-BUILD-REC-TYPE-1
               WHEN W0001-T231MNEM-REC-TYPE-2
                    PERFORM J200-BUILD-REC-TYPE-2
           END-EVALUATE.

           PERFORM J400-INSERT-T231MNEM.

           EJECT
       J100-BUILD-REC-TYPE-1.

           MOVE 'J100' TO CA-PARAGRAPH-NBR.

           MOVE W0001-MNEM-RECTYP-C
             TO DB-RECTYP-C   IN DCLT231MNEM.
           MOVE W0001-F-MNEM-N
             TO F-MNEM-N      IN DCLT231MNEM.
           MOVE W0001-F-MNEM-C
             TO F-MNEM-C      IN DCLT231MNEM.
           MOVE SPACES
             TO F-MNEMPT-C    IN DCLT231MNEM.
           MOVE W0001-F-PDHDG01-C
             TO F-PDHDG01-C   IN DCLT231MNEM.
           MOVE W0001-F-PDHDG02-C
             TO F-PDHDG02-C   IN DCLT231MNEM.
           MOVE W0001-F-RLS-C
             TO F-RLS-C       IN DCLT231MNEM.
           MOVE W0001-F-AVG-C
             TO F-AVG-C       IN DCLT231MNEM.
           MOVE W0001-F-FCSACT-C
             TO F-FCSACT-C    IN DCLT231MNEM.
           MOVE W0001-F-BEGIX-C
             TO F-BEGIX-C     IN DCLT231MNEM.
           MOVE W0001-F-ENDIX-C
             TO F-ENDIX-C     IN DCLT231MNEM.
           MOVE W0001-MNEM-A-CPY-N
             TO A-CPY-N       IN DCLT231MNEM.
           MOVE W0001-MNEM-F-DIV-C
             TO F-DIV-C       IN DCLT231MNEM.
           MOVE W0001-F-BALIX-C
             TO F-BALIX-C     IN DCLT231MNEM.

           EJECT
       J200-BUILD-REC-TYPE-2.

           MOVE 'J200' TO CA-PARAGRAPH-NBR.

           MOVE W0001-MNEM-RECTYP-C2
             TO DB-RECTYP-C   IN DCLT231MNEM.
           MOVE W0001-F-MNEM-N2
             TO F-MNEM-N      IN DCLT231MNEM.
           MOVE W0001-F-MNEM-C2
             TO F-MNEM-C      IN DCLT231MNEM.
           MOVE W0001-F-MNEMPT-C2
             TO F-MNEMPT-C    IN DCLT231MNEM.
           MOVE W0001-F-PDHDG01-C2
             TO F-PDHDG01-C   IN DCLT231MNEM.
           MOVE W0001-F-PDHDG02-C2
             TO F-PDHDG02-C   IN DCLT231MNEM.
           MOVE SPACES
             TO F-RLS-C       IN DCLT231MNEM
           MOVE SPACES
             TO F-AVG-C       IN DCLT231MNEM.
           MOVE SPACES
             TO F-FCSACT-C    IN DCLT231MNEM.
           MOVE SPACES
             TO F-BEGIX-C     IN DCLT231MNEM.
           MOVE SPACES
             TO F-ENDIX-C     IN DCLT231MNEM.
           MOVE SPACES
             TO A-CPY-N       IN DCLT231MNEM.
           MOVE SPACES
             TO F-DIV-C       IN DCLT231MNEM.
           MOVE SPACES
             TO F-BALIX-C     IN DCLT231MNEM.

           EJECT
       J400-INSERT-T231MNEM.

           MOVE 'J400' TO CA-PARAGRAPH-NBR.

           EXEC SQL
             INSERT INTO D231.T231MNEM
                 ( DB_RECTYP_C
                 , F_MNEM_N
                 , F_MNEM_C
                 , F_MNEMPT_C
                 , F_PDHDG01_C
                 , F_PDHDG02_C
                 , F_RLS_C
                 , F_AVG_C
                 , F_FCSACT_C
                 , F_BEGIX_C
                 , F_ENDIX_C
                 , A_CPY_N
                 , F_DIV_C
                 , F_BALIX_C
                 , DB_UPD_D
                 , DB_UPD_T )
             VALUES
                 ( :DCLT231MNEM.DB-RECTYP-C
                 , :DCLT231MNEM.F-MNEM-N
                 , :DCLT231MNEM.F-MNEM-C
                 , :DCLT231MNEM.F-MNEMPT-C
                 , :DCLT231MNEM.F-PDHDG01-C
                 , :DCLT231MNEM.F-PDHDG02-C
                 , :DCLT231MNEM.F-RLS-C
                 , :DCLT231MNEM.F-AVG-C
                 , :DCLT231MNEM.F-FCSACT-C
                 , :DCLT231MNEM.F-BEGIX-C
                 , :DCLT231MNEM.F-ENDIX-C
                 , :DCLT231MNEM.A-CPY-N
                 , :DCLT231MNEM.F-DIV-C
                 , :DCLT231MNEM.F-BALIX-C
                 , CURRENT DATE
                 , CURRENT TIME )
           END-EXEC.

           SET DUP-KEY        TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               ADD +1 TO W0000-OUTPUT-CTR
           END-IF.

      *
      **=======================================================**
      **         COPYBOOK FOR ERROR HANDLING ROUTINE           **
      **=======================================================**
           EXEC SQL
                INCLUDE C108B900
           END-EXEC.

